如何使用VBA for Microsoft Office从电子表格中使用ftp，http或套接字上载数据？

我有一个Excel电子表格，我想把一个button，所以用户将能够上传他们的数据到一个http / ftp服务器，或直接发送数据到服务器使用套接字。 我注意到有人创build了一个ftp脚本来做。 首先，我不确定每个人在他们的Windows机器上都有ftp，其次，我宁愿使用一种方法来更好地监视上传的进度。 例如，我想知道用户标识/密码是否失败，如果传输成功完成，是否与接收服务器有任何其他types的错误。 谢谢。

Answer 1

我写了一个在VBA中使用的FTP类，它使用Windows API函数传输文件：

Option Explicit ' die wichtigsten Funktionen und Typen aus dem WinInet-API Private Const MAX_PATH = 260 Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 Private Const INTERNET_FLAG_ASYNC = &H10000000 Private Const INTERNET_DEFAULT_FTP_PORT = 21 Private Const INTERNET_SERVICE_FTP = 1 Private Const FTP_TRANSFER_TYPE_BINARY As Long = 2 Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As Currency ftLastAccessTime As Currency ftLastWriteTime As Currency nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Long, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Long, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Long) As Boolean Private Declare Function FtpPutFile Lib "WinInet" Alias "FtpPutFileA" (ByVal hFtp As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Declare Function FtpGetFile Lib "WinInet" Alias "FtpGetFileA" (ByVal hFtp As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Declare Function FtpDeleteFile Lib "WinInet" Alias "FtpDeleteFileA" (ByVal hFtp As Long, ByVal lpszKillFile As String) As Long Private Declare Function FtpCreateDirectory Lib "WinInet" Alias "FtpCreateDirectoryA" (ByVal hFtp As Long, ByVal lpszNewDir As String) As Long Private Declare Function FtpGetCurrentDirectory Lib "WinInet" Alias "FtpGetCurrentDirectoryA" (ByVal hFtp As Long, lpszDirectory As String, ByVal BuffLength As Long) As Long Private Declare Function FtpSetCurrentDirectory Lib "WinInet" Alias "FtpSetCurrentDirectoryA" (ByVal hFtp As Long, ByVal lpszDirectory As String) As Long Private Declare Function FtpRemoveDirectory Lib "WinInet" Alias "FtpRemoveDirectoryA" (ByVal hFtp As Long, ByVal lpszKillDir As String) As Long Private Declare Function FtpFindFirstFile Lib "WinInet" Alias "FtpFindFirstFileA" (ByVal hFtp As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Declare Function FtpRenameFile Lib "WinInet" Alias "FtpRenameFileA" (ByVal hFtp As Long, ByVal lpszCurFile As String, ByVal lpszNewFile As String) As Long Private Declare Function GetLastError Lib "kernel" () As Integer ' Member der Klasse Private m_hConnect As Long Private m_hFtp As Long Private Sub Class_Initialize() m_hConnect = 0 m_hFtp = 0 End Sub Private Sub Class_Terminate() Disconnect End Sub Public Sub Connect(server As String, user As String, pwd As String) m_hConnect = InternetOpen("Microsoft Excel", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) 'INTERNET_FLAG_ASYNC) If m_hConnect = 0 Then Err.Raise vbObjectError + 1, , "Verbindung konnte nicht hergestellt werden! Fehler " + CStr(GetLastError) Exit Sub End If m_hFtp = InternetConnect(m_hConnect, server, INTERNET_DEFAULT_FTP_PORT, user, pwd, INTERNET_SERVICE_FTP, 0, 0) If m_hFtp = 0 Then Err.Raise vbObjectError + 1, , "Verbindung konnte nicht hergestellt werden! Fehler " + CStr(GetLastError) Exit Sub End If End Sub Public Sub Disconnect() If m_hConnect <> 0 Then InternetCloseHandle m_hConnect m_hFtp = 0 m_hConnect = 0 End If End Sub Public Sub ChangeDir(RemoteDirectory As String) Dim ret As Long ret = FtpSetCurrentDirectory(m_hFtp, RemoteDirectory) If ret = 0 Then MsgBox CStr(Err.LastDllError) Err.Raise vbObjectError + 1, , LastError() End If End Sub Public Function CurrentDir() As String Dim ret As String ret = Space(1024) FtpGetCurrentDirectory m_hFtp, ret, 1023 CurrentDir = ret End Function Public Sub PutFile(LocalFilename As String, RemoteFilename As String) If FtpPutFile(m_hFtp, LocalFilename, RemoteFilename, FTP_TRANSFER_TYPE_BINARY, 0) = 0 Then Err.Raise vbObjectError + 1, , LastError End If End Sub Private Function LastError() As String Dim ret As String Dim nErr As Long ret = Space(1024) InternetGetLastResponseInfo nErr, ret, 1024 LastError = ret End Function 

像这样使用它：

 Dim ftp As New CFtp ftp.Connect GetVar("SERVER"), GetVar("USER"), GetVar("PASS") ftp.PutFile FILENAME, "/httpdocs/ang.html" ftp.Disconnect 

Answer 2

不知道你是否想要处理Microsoft Internet Transfer Control（msinet.ocx），但它是一个可以为你提供所需控制的选项。 这是一个很好的资源的链接，让你开始： http : //officeone.mvps.org/vba/ftp_upload_file.html

Answer 3

这个简单的ftpfile upload代码（根据网上的代码进行调整）在VBA excel项目中很好地工作，而不必处理MSINET问题：

不要忘记：
– 为您的项目引用“Microsoft Internet控件”
– 将声明语句放在模块的顶部

Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _ ByVal hInternetSession As Long, ByVal sServerName As String, _ ByVal nServerPort As Integer, ByVal sUserName As String, _ ByVal sPassword As String, ByVal lService As Long, _ ByVal lFlags As Long, ByVal lContext As Long) As Long Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _ ByVal sAgent As String, ByVal lAccessType As Long, _ ByVal sProxyName As String, _ ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _ "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _ ByVal lpszDirectory As String) As Boolean Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" ( _ ByVal hConnect As Long, _ ByVal lpszLocalFile As String, _ ByVal lpszNewRemoteFile As String, _ ByVal dwFlags As Long, _ ByRef dwContext As Long) As Boolean
Sub simpleFtpFileUpload() Internet_OK = InternetOpen("", 1, "", "", 0) If Internet_OK Then FTP_OK = InternetConnect(Internet_OK, "ftp", INTERNET_DEFAULT_FTP_PORT, "user", "password", 1, 0, 0) If FtpSetCurrentDirectory(FTP_OK, "/") Then success = FtpPutFile(FTP_OK, ThisWorkbook.Path & "\sourceFile", "transferedFile", FTP_TRANSFER_TYPE_BINARY, 0) End If End If If success Then Debug.Print "ftp success ;)" Else Debug.Print "ftp failure :(" End If End Sub