2010-06-25 25 views
0

我希望能够将合并的Word文档的内容发送到数据库,无论是单击菜单栏上的按钮,还是关闭(如果已保存)。通过单击按钮将Word文件传输到数据库或FTP?

,我发现了一些工作的代码,但有一个问题想修改(VBA小白)

'Written: June 11, 2008 
'Author: Leith Ross 

'Open the Internet object 
Private Declare 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 

'Connect to the network 
Private Declare 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 

'Get a file using FTP 
Private Declare Function FtpGetFile _ 
    Lib "wininet.dll" _ 
    Alias "FtpGetFileA" _ 
     (ByVal hFtpSession As Long, _ 
     ByVal lpszRemoteFile As String, _ 
     ByVal lpszNewFile As String, _ 
     ByVal fFailIfExists As Boolean, _ 
     ByVal dwFlagsAndAttributes As Long, _ 
     ByVal dwFlags As Long, _ 
     ByVal dwContext As Long) As Boolean 

'Send a file using FTP 
Private Declare Function FtpPutFile _ 
    Lib "wininet.dll" _ 
    Alias "FtpPutFileA" _ 
     (ByVal hFtpSession As Long, _ 
     ByVal lpszLocalFile As String, _ 
     ByVal lpszRemoteFile As String, _ 
     ByVal dwFlags As Long, _ 
     ByVal dwContext As Long) As Boolean 

'Close the Internet object 
Private Declare Function InternetCloseHandle _ 
    Lib "wininet.dll" _ 
    (ByVal hInet As Long) As Integer 

Sub AutoClose() 

    Dim INet As Long 
    Dim INetConn As Long 
    Dim hostFile As String 
    Dim localFile As String 
    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 


    ServerName = "ftp.myserver.com" 
    UserName = "myusername" 
    Password = "password" 

    'This fails if I use localFile = ActiveDocument.FullName 
    'but is OK if localFile is hardcoded 

    localFile = "f:\My Documents\Test.Txt" 
    hostFile = ActiveDocument.Name 

    If Len(ActiveDocument.Path) = 0 Then 
     MsgBox "The document must be saved first." 
     Exit Sub 
    End If 

     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 
       Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&) 
       RetVal = InternetCloseHandle(INetConn) 
      End If 
     RetVal = InternetCloseHandle(INet) 
     End If 

     If Success <> 0 Then 
     MsgBox ("Upload process completed") 
     Else 
     MsgBox "FTP File Error!" 
     End If 

End Sub 

我想LOCALFILE变量是动态的,反映了这一当前文档,但如果硬编码它只能。我哪里错了?

+0

如果您使用localFile和hostFile建议的动态名称,您是不是试图将文档写入自己? – 2010-06-25 00:36:56

回答

3

已编辑,现在可以将当前word文档的副本发送到ftp服务器。

'Written: June 11, 2008 
'Author: Original author Leith Ross 
'Amended: Jun 25, 2010 Saul Galloway 

'Open the Internet object 
Private Declare 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 

'Connect to the network 
Private Declare 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 

'Get a file using FTP 
Private Declare Function FtpGetFile _ 
    Lib "wininet.dll" _ 
    Alias "FtpGetFileA" _ 
     (ByVal hFtpSession As Long, _ 
     ByVal lpszRemoteFile As String, _ 
     ByVal lpszNewFile As String, _ 
     ByVal fFailIfExists As Boolean, _ 
     ByVal dwFlagsAndAttributes As Long, _ 
     ByVal dwFlags As Long, _ 
     ByVal dwContext As Long) As Boolean 

'Send a file using FTP 
Private Declare Function FtpPutFile _ 
    Lib "wininet.dll" _ 
    Alias "FtpPutFileA" _ 
     (ByVal hFtpSession As Long, _ 
     ByVal lpszLocalFile As String, _ 
     ByVal lpszRemoteFile As String, _ 
     ByVal dwFlags As Long, _ 
     ByVal dwContext As Long) As Boolean 

'Close the Internet object 
Private Declare Function InternetCloseHandle _ 
    Lib "wininet.dll" _ 
    (ByVal hInet As Long) As Integer 

Sub AutoClose() 

    Dim INet As Long 
    Dim INetConn As Long 
    Dim hostFile As String 
    Dim localFile As String 
    Dim Password As String 
    Dim RetVal As Long 
    Dim ServerName As String 
    Dim Success As Long 
    Dim UserName As String 
    Dim currentFileAndPath As String 

    Const ASCII_TRANSFER = 1 
    Const BINARY_TRANSFER = 2 


    ServerName = "ftp.yourserver.com" 
    UserName = "username" 
    Password = "yourpassword" 

    currentFileAndPath = ActiveDocument.FullName 
    ActiveDocument.SaveAs ("C:\TempFile.doc") 
    ActiveDocument.SaveAs (currentFileAndPath) 

    localFile = "C:\TempFile.doc" 
    hostFile = ActiveDocument.Name 

    If Len(ActiveDocument.Path) = 0 Then 
     MsgBox "The document must be saved first." 
     Exit Sub 
    End If 

     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 
       Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&) 
       RetVal = InternetCloseHandle(INetConn) 
      End If 
     RetVal = InternetCloseHandle(INet) 
     End If 

     If Success <> 0 Then 
     MsgBox ("Upload process completed") 
     Else 
     MsgBox "FTP File Error!" 
     End If 

End Sub 
相关问题