导入到Access

Question

情况： 我正在迭代Outlook-Mailbox并将所有附件下载到特定文件夹中。然后我遍历文件夹并将CSV文件导入Access。

问题： 我有Outlook.MailItem.receiveTime属性和发件人的名字，我从文件标题中获得。我想将这两条信息添加到每个CSV文件的每一行。

问题： 是否有可能在导入时添加这两列，或者我是否必须打开每个文件并遍历内容以添加它们？

小问题： 是否可以直接从Outlook导入文件，这意味着，不需要保存它们？

我使用的软件和语言：      - 2013年访问     -Outlook 2013     -VBA     -SQL     小方信息：我从访问表单中触发所有这些。

Answer 1

您可以遍历所有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”是您的电子邮件地址。