在導入到Access時添加列

情況： 我通過Outlook郵箱迭代並將所有附件下載到特定文件夾中。然後我遍歷這些文件夾並將CSV文件導入到Access中。在導入到Access時添加列

問題： 我有Outlook.MailItem.receiveTime屬性和發件人的名稱，我從文件標題獲得。我想將這兩條信息添加到每個CSV文件的每一行。

問：是否有可能增加對進口的兩列或做我必須打開每個文件，並通過內容重複添加它們？

小方面的問題： 是否有可能直接從Outlook導入文件，也就是說，不需要保存以保存它們？

軟件和語言的使用： - 訪問2013 -Outlook 2013 -VBA -SQL 副作用小資料：我觸發這一切從Access表。

來源

2017-07-07 Lukas

a）在Outlook（文件/選項/高級）中有一個內置導出和b）在Access（外部數據/更多/ Outlook文件夾）中有一個內置導入。你見過這些嗎？ –

我還沒有，我可以使用VBA中的那些嗎？ – Lukas

好吧，我看了一下你的意思，但是這些工具並沒有爲我完成這項工作，因爲它們都導出/導入電子郵件，但我只需要附件/附件中的信息。 – Lukas

您可以遍歷所有CSV文件並將每個文件導入到表格中。

Private Sub Command0_Click() 

    Const strPath As String = "C:\your_path_here\" 'Directory Path 
    Dim strFile As String 'Filename 
    Dim strFileList() As String 'File Array 
    Dim intFile As Integer 'File Number 

    'Loop through the folder & build file list 
    strFile = Dir(strPath & "*.csv") 
    While strFile <> "" 
     'add files to the list 
     intFile = intFile + 1 
     ReDim Preserve strFileList(1 To intFile) 
     strFileList(intFile) = strFile 
     strFile = Dir() 
    Wend 
    'see if any files were found 
    If intFile = 0 Then 
     MsgBox "No files found" 
     Exit Sub 
    End If 
    'cycle through the list of files & import to Access 
    'creating a new table called MyTable 
    For intFile = 1 To UBound(strFileList) 
     DoCmd.TransferText acImportDelimi, , _ 
     "Test", strPath & strFileList(intFile) 
     'Check out the TransferSpreadsheet options in the Access 
     'Visual Basic Help file for a full description & list of 
     'optional settings 
    Next 
    MsgBox UBound(strFileList) & " Files were Imported" 
End Sub

如果你想從Outlook下載附件，試試這個。

Private Sub GetAttachments() 

    Dim ns As Namespace 
    Dim Inbox As Outlook.MAPIFolder 
    Dim Item As Object 
    Dim Atmt As Outlook.Attachment 
    Dim FileName As String 

    Set ns = GetNamespace("MAPI") 
    Set Inbox = ns.Folders("MailboxName").Folders("Inbox") 

    If Inbox.Items.Count = 0 Then 
     MsgBox "There are no messages in the Inbox.", vbInformation, _ 
       "Nothing Found" 
     Exit Sub 
    End If 

    For Each Item In Inbox.Items 
     For Each Atmt In Item.Attachments 
      If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then 
       FileName = "C:\attachments\" & Atmt.FileName 
       Atmt.SaveAsFile FileName 
      End If 
     Next Atmt 
    Next Item 

End Sub

設置對MS Outlook的引用，請記住，「MailboxName」是您的電子郵件地址。

來源

2017-07-07 13:48:19 ryguy72

謝謝，我會馬上嘗試 – Lukas

如果它可以幫助你，請將它標記爲答案。我試過了，它對我來說工作得很好。 – ryguy72

在導入到Access時添加列

回答

相關問題