Outlook 2010 宏以保存附件并将其通过 FTP 传输到 Web 服务器

Question

这是我第一次尝试这样的事情并且遇到了一些问题。

我写了下面的代码，它是一个 Outlook 2010 宏。 它将选定的电子邮件详细信息保存在 SQL 数据库中，将所有附件保存在本地，然后尝试通过 FTP 上传它们。

它看起来好像在命令窗口打开时尝试上传，但随后又快速关闭，但文件尚未上传，我没有收到任何错误信息。

任何人都可以看到我的代码有任何问题吗？

Sub ExportToSql()
Dim objConn As New ADODB.Connection
Dim rsMsgs As New ADODB.Recordset
Dim cmdMsgs As New ADODB.Command
Dim strDBFile As String
Dim sql As String
Set objConn = New ADODB.Connection

objConn.ConnectionString = "Provider=SQLOLEDB;data source=IP_ADDRESS;initial catalog=DB_NAME;User Id=USERNAME;Password=PASSWORD;"
objConn.Open

Set objExp = Application.ActiveExplorer
If objExp.Selection.Count > 0 Then
    If objExp.Selection(1).Class = Outlook.OlObjectClass.olMail Then
        For Each objMsg In objExp.Selection

            cmdMsgs.ActiveConnection = objConn
            cmdMsgs.CommandText = "INSERT INTO [Email] ([Date], [Subject], [From], [To], [Body]) VALUES ( ?, ?, ?, ?, ?)"
            cmdMsgs.Parameters.Append cmdMsgs.CreateParameter("param1", adDBTime, adParamInput, -1, objMsg.SentOn)
            cmdMsgs.Parameters.Append cmdMsgs.CreateParameter("param2", adLongVarChar, adParamInput, 1000, objMsg.Subject)
            cmdMsgs.Parameters.Append cmdMsgs.CreateParameter("param3", adVarChar, adParamInput, -1, objMsg.SenderEmailAddress)
            cmdMsgs.Parameters.Append cmdMsgs.CreateParameter("param4", adVarChar, adParamInput, -1, objMsg.To)
            cmdMsgs.Parameters.Append cmdMsgs.CreateParameter("param5", adLongVarChar, adParamInput, 50000, objMsg.Body)
            cmdMsgs.Execute

            For Each objAtt In objMsg.Attachments

                'save file locally
                Dim saveFolder As String
                Dim filePath As String
                saveFolder = "C:\Users\jw"
                filePath = saveFolder & "\" & objAtt
                objAtt.SaveAsFile filePath
                Set objAtt = Nothing



                'upload saved file
                Dim vPath As String
                Dim vFile As String
                Dim vFTPServ As String
                vPath = "C:\inetpub\wwwroot\WEBSITE\attachments"
                vFTPServ = "IPADDRESS"
                fNum = FreeFile()
                Open filePath For Output As #fNum
                Print #fNum, "USERNAME PASSWORD"
                Print #fNum, "bin" ' bin or ascii file type to send
                Print #fNum, "put " & filePath
                Print #fNum, "close" ' close connection
                Print #fNum, "quit" ' Quit ftp program
                Close
                Shell "ftp -n -i -g -s:" & vPath & " " & vFTPServ, vbNormalNoFocus

            Next
        Next
    End If
End If

    objConn.Close
    Set rsMsgs = Nothing
    Set objConn = Nothing

End Sub

谢谢你的帮助。 J。

Answer 1

我认为用户名和密码应该在两个单独的行上。 此外，使用“>>”代替“>”将 FTP 命令结果输出到文本文件。