title: Outlook 2010 Macro to save attachment and FTP it to web server
body: <p>This is the first time i've tried anything like this and having a few issues.</p>
  
  <p>i've written the code below which is a Outlook 2010 Macro. It Saves a selected email details in an SQL database, saves any attachements locally and then attempts to upload them via FTP.</p>
  
  <p>It looks as if it's attempting to upload as a command window opens, but then quickly closes again but the files haven't been uploaded and I don't get any error information.</p>
  
  <p>Can anyone see any issues with my code?</p>
  
  <pre><code>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 &gt; 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 &amp; "\" &amp; 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 " &amp; filePath
                  Print #fNum, "close" ' close connection
                  Print #fNum, "quit" ' Quit ftp program
                  Close
                  Shell "ftp -n -i -g -s:" &amp; vPath &amp; " " &amp; vFTPServ, vbNormalNoFocus
  
              Next
          Next
      End If
  End If
  
      objConn.Close
      Set rsMsgs = Nothing
      Set objConn = Nothing
  
  End Sub
  </code></pre>
  
  <p>Thanks for any help.
  J.</p>