Excel - Tabelle 2010 per FTP auf Website uploaden

'Open the Internet object  
 Private Declare PtrSafe Function InternetOpen _
   Lib "wininet.dll" _  
     Alias "InternetOpenA" _  
       (ByVal sAgent As String, _
        ByVal lAccessType As LongPtr, _
        ByVal sProxyName As String, _
        ByVal sProxyBypass As String, _
        ByVal lFlags As LongPtr) As Long
 
'Connect to the network  
 Private Declare PtrSafe Function InternetConnect _
   Lib "wininet.dll" _  
     Alias "InternetConnectA" _  
       (ByVal hInternetSession As LongPtr, _
        ByVal sServerName As String, _
        ByVal nServerPort As Integer, _
        ByVal sUsername As String, _
        ByVal sPassword As String, _
        ByVal lService As LongPtr, _
        ByVal lFlags As LongPtr, _
        ByVal lContext As Long) As Long
 
'Get a file using FTP  
 Private Declare PtrSafe Function FtpGetFile _
   Lib "wininet.dll" _  
     Alias "FtpGetFileA" _  
       (ByVal hFtpSession As LongPtr, _
        ByVal lpszRemoteFile As String, _
        ByVal lpszNewFile As String, _
        ByVal fFailIfExists As Boolean, _
        ByVal dwFlagsAndAttributes As LongPtr, _
        ByVal dwFlags As LongPtr, _
        ByVal dwContext As LongPtr) As Boolean
 
'Send a file using FTP  
 Private Declare PtrSafe Function FtpPutFile _
   Lib "wininet.dll" _  
     Alias "FtpPutFileA" _  
       (ByVal hFtpSession As LongPtr, _
        ByVal lpszLocalFile As String, _
        ByVal lpszRemoteFile As String, _
        ByVal dwFlags As LongPtr, _
        ByVal dwContext As LongPtr) As Boolean
 
'Close the Internet object  
 Private Declare PtrSafe Function InternetCloseHandle _
   Lib "wininet.dll" _  
     (ByVal hInet As LongPtr) As Integer
 
Sub UploadFTP()
 
Dim pdfName As String
Dim pdfOpenAfterPublish As Boolean
Dim olApp As Object
Dim olOldBody As String
Dim hostFile As String
Dim INet As Long
Dim INetConn As Long
Dim Password As String
Dim RetVal As Long
Dim ServerName As String
Dim Success As Long
Dim UserName As String
  
Const ASCII_TRANSFER = 1
Const BINARY_TRANSFER = 2

'Rückfragen, ob Datei nach dem Erstellen geöffnet werden soll  
If MsgBox("Soll die PDF-Datei nach dem Erstellen angezeigt werden?", vbYesNo, "PDF anzeigen?") = vbYes Then pdfOpenAfterPublish = True  

'Pfad und Name der PDF-Datei  
pdfName = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_" & ActiveSheet.Name & ".pdf"  

'PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, nicht in Excel 2003 oder älter  
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
                                   Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)
                                              
'Boolean-Variable "pdfOpenAfterPublish" zurücksetzen  
pdfOpenAfterPublish = False
 
'Ftp Daten bitte ändern  
ServerName = "dein.ftp.de"  
UserName = "Dein_Benutzer_Name"  
Password = "Dein_Passwort"  

'localFile lassen, hostFile "/Test/" an Serververzeichnis anpassen (Verzeichnis muss auf dem Server existieren!)  
'Zeigt der Ftp-Zugang direkt auf das Verzweichnis dann: hostFile = ThisWorkbook.Name & "_" & ActiveSheet.Name & ".pdf"  
localFile = pdfName
hostFile = "/Test/" & ThisWorkbook.Name & "_" & ActiveSheet.Name & ".pdf"  
 
      RetVal = False
      INet = InternetOpen("MyFTP Control", 1&, vbNullString, vbNullString, 0&)  
        If INet > 0 Then
          INetConn = InternetConnect(INet, ServerName, 0&, UserName, Password, 1&, 0&, 0&)
            If INetConn > 0 Then
              'Abfrage kann ausgeblendet werden mit 'If MsgBox.. und beim nächsten 'End If  
              If MsgBox("Soll die PDF-Datei auf den Server geladen werden?" & vbCrLf & "Gleichnamige Dateien werden überschrieben!", vbYesNo, "PDF hochladen?") = vbYes Then  
                Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&)
                RetVal = InternetCloseHandle(INetConn)
              End If
            End If
         RetVal = InternetCloseHandle(INet)
        End If
 
      If Success <> 0 Then
        MsgBox ("Upload erfolgreich beendet!")  
      Else
        MsgBox "Abbruch durch Benutzer oder FTP Server/ Datei Fehler!"  
      End If
 
End Sub