Genial einfach - oder?
| A wie Anton | B wie Berta |
|---|---|
| ... and more lorem ... and more ipsum ... and more dolor... | |
Excel generiert aus den Daten eine json-Datei und lädt diese automatisch via ftp auf den Webspace.
Nebenbei kann auch eine Word-Seriendruck-Datei angesprochen werden, um bspw. die Daten für eine Restaurant-Speisenkarte in Excel zusammenzustellen, in Word die Speisenkarte zu drucken und abschliessend alles VOLL automatisch auf den Webspace zu laden...
| A wie Anton | B wie Berta |
|---|---|
| ... and more lorem ... and more ipsum ... and more dolor... | |
Mehr unter bugs Stichwort: offlineCMS/Excel…
Alle Einstellungen für Dateinamen und ftp-Zugang bitte in Sub Fertig anpassen...
Option Explicit
Public JSONFileName As String
Public WORDFileName As String
Public WorkSheetName As String
Public UserFTP As String
Public PwdFTP As String
Public ServerFTP As String
Public FTPDirectory As String
Public FTPWait As String
Public Sub Fertig()
'Dateinamen richtig einstellen
JSONFileName = ActiveWorkbook.Path & "\test_CMS.json"
WORDFileName = ActiveWorkbook.Path & "\test_CMS.docx"
'Excel richtig einstellen
WorkSheetName = "Test" 's.a. Excel-Datei
'FTP richtig einstellen
UserFTP = "user"
PwdFTP = "pwd"
ServerFTP = "ftp.example.com"
FTPDirectory = "test/gaga"
FTPWait = "30" 'Sekunden
'alles ausführen
SaveAsJSON
OpenWord
UploadFTP
'Excel beenden
Me.Save
Application.Quit
End Sub
Private Sub SaveAsJSON()
Dim jsonfile As Object
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
Set rangetoexport = ThisWorkbook.Worksheets(WorkSheetName).UsedRange
Set jsonfile = CreateObject("ADODB.Stream")
linedata = "["
For rowcounter = 2 To rangetoexport.Rows.Count
linedata = linedata + "{"
For columncounter = 1 To rangetoexport.Columns.Count
linedata = linedata & """" & _
Replace(rangetoexport.Cells(1, columncounter), """", "'") & _
"""" & _
":" & _
"""" & _
Replace(rangetoexport.Cells(rowcounter, columncounter), """", "'") & _
""""
If columncounter > rangetoexport.Columns.Count Then
linedata = linedata & ","
Else
linedata = linedata & """"
End If
Next
linedata = Left(linedata, Len(linedata) - 1)
If rowcounter = rangetoexport.Rows.Count Then
linedata = linedata & "}"
Else
linedata = linedata & "},"
End If
Next
linedata = linedata & "]"
With jsonfile
.Type = 2
.Charset = "utf-8"
.Open
.WriteText linedata
.SaveToFile JSONFileName, 2
End With
Set jsonfile = Nothing
End Sub
Private Sub OpenWord()
Dim w As Object
Set w = CreateObject("word.application")
w.Visible = 1
w.Documents.Open Filename:=WORDFileName
Set w = Nothing
End Sub
Private Sub UploadFTP()
Dim tmp_Script As String
Dim tmp_Batch As String
Dim fs
Dim a
Dim dRetVal
tmp_Script = ActiveWorkbook.Path & "\script_MSO.dat"
tmp_Batch = ActiveWorkbook.Path & "\upload_MSO.bat"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(tmp_Script, True)
With a
.writeline UserFTP
.writeline PwdFTP
.writeline "binary"
.writeline "cd " & FTPDirectory
.writeline "put """ & JSONFileName & """"
.writeline "quit"
.Close
End With
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(tmp_Batch, True)
With a
.writeline "ftp -i -s:""" & tmp_Script & """" & " " & ServerFTP
.Close
End With
dRetVal = Shell(tmp_Batch, 0)
Application.Wait (Now + TimeValue("0:00:" & FTPWait))
Kill tmp_Script
Kill tmp_Batch
Set fs = Nothing
Set a = Nothing
Set dRetVal = Nothing
End Sub
Der jquery-Quelltext zum Einlesen der json-Daten findet Ihr in dieser HTML-Datei am Ende unter <script> :)