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

时间:2012-12-05 16:43:52

标签: vb.net ms-office outlook-vba office-2010

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

我编写了下面的代码,它是一个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

感谢您的帮助。 学家

1 个答案:

答案 0 :(得分:0)

我认为用户名和密码应分为两行。另外,使用“>>”而不是“>”将FTP命令结果输出到文本文件。