时间戳

首页 > 解决方案 > 将 CSV/Excel 文件读入数组

vba - 将 CSV/Excel 文件读入数组

问题描述

我正在尝试制作一个宏，当我收到电子邮件时复制它们，并根据域名将它们保存在网络驱动器上的特定 Windows 文件夹中。

我拥有的域列表将很大，并且可能会被没有编码经验的用户更改，因此我希望开发一个文本、CSV 或 excel 文件，以便有人可以更新它列出我公司与他们的关系（客户、供应商、子-contractor 等...）及其名称（两者都控制文件路径），域名（@example.com）。

我想我可以弄清楚如何做大部分事情（嵌套 if 和 for 语句的巧妙组合），但我不知道如何将文件读入数组，而且我的 google-fu 让我失望了。

我不认为它真的有帮助，但这是我从网上无耻地复制并计划使用的代码。

Option Explicit
Private WithEvents InboxItems As Outlook.Items

Sub Application_Startup()
    Dim xNameSpace As Outlook.NameSpace
    Set xNameSpace = Outlook.Application.Session
    Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
    Dim FSO
    Dim xMailItem As Outlook.MailItem
    Dim xFilePath As String
    Dim xRegEx
    Dim xFileName As String
    Dim SenderAddress As String
    On Error Resume Next

    ' Define SenderAddress as sender's email address or domain
    xFilePath = PathCreator(SenderAddress)

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(xFilePath) = False Then
        FSO.CreateFolder (xFilePath)

    End If

    Set xRegEx = CreateObject("vbscript.regexp")
    xRegEx.Global = True
    xRegEx.IgnoreCase = False
    xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

    If objItem.Class = olMail Then
        Set xMailItem = objItem
        xFileName = xRegEx.Replace(xMailItem.Subject, "")
        xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML

    End If
    Exit Sub

End Sub

Function PathCreator(SenderAddress)

' [needs to read the file and create the path based on the values]

End Function

标签： vbacsvoutlook

解决方案

您可以使用 ADODB 连接到源文件，并将其读入二维数组。从Tools -> References...添加对Microsoft ActiveX 数据对象的引用。例如，如果您想使用 Excel 文件：

Dim excelPath As String
excelPath = "C:\path\to\excel\file.xlsx" ' Replace with the path to the Excel file

Dim connectionString As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & excelPath & """;" & _
    "Extended Properties=""Excel 12.0;HDR=Yes"""
'This assumes the Excel file contains column headers -- HDR=Yes

Dim sql As String
sql = "SELECT Relationship, LastName, FirstName, DomainName FROM [Sheet1$]"
'Assumes the relevant worksheet is named Sheet1
'Also assumes the first row of the sheet has the following labels: Relationship, LastName, FirstName, Domain (in no particular order)

Dim rs As New ADODB.Recordset
rs.Open sql, connectionString

Dim arr As Variant
arr = rs.GetRows 'Puts the data from the recordset into an array
rs.Close 
Set rs = Nothing

Dim row As Variant, column As Variant
For row = 0 To UBound(arr, 2)
    For column = 0 To UBound(arr, 1)
        Debug.Print arr(column, row)
    Next
Next

使用文本文件或 CSV 只需稍微更改连接字符串和 SQL。但我认为使用 Excel 文件将迫使用户将数据保存在列中，而在 CSV 中，用户必须手动插入字段和行分隔符；任何其他文本格式也是如此——用户必须记住格式的规则并正确应用它们。

但是我质疑数组是否是您使用的最佳数据结构；在这种情况下，您可以直接使用记录集。为了确保文件没有保持打开状态，您可以使用断开连接的记录集。（如果您打算找到合适的域名并使用它来获取其他详细信息，那么我建议您将记录集中的数据加载到 Scripting.Dictionary 中。）

另请注意，您可能只需要从文件中加载一次数据，除非您希望它在代码运行时发生更改。

我会写这样的东西

Dim rs As ADODB.Recordset

Function PathCreator(SenderAddress) As String
    If rs Is Nothing Then
        Dim excelPath As String
        excelPath = "C:\path\to\excel\file.xlsx" ' Replace with the path to the Excel file

        Dim connectionString As String
        connectionString = _
            "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=""" & excelPath & """;" & _
            "Extended Properties=""Excel 12.0;HDR=Yes"""

        Dim sql As String
        sql = "SELECT Relationship, LastName, FirstName, DomainName FROM [Sheet1$]"

        Set rs As New ADODB.Recordset
        rs.CursorLocation = adUseClient
        rs.CursorType = adOpenStatic
        rs.Open sql, connectionString, adOpenStatic, adLockBatchOptimistic

        'Disconnect the recordset
        rs.ActiveConnection = Nothing

        'Now the data will still be available as long as the code is running
        'But the connection to the Excel file will be closed
    End If

    'build the path here, using the recordset fields
    PathCreator = rs!Relationship & "_" & rs!LastName & "_" & rs!FirstName & "_" & rs!Domain
End Function

注意。同理，您可以添加对Microsoft Scripting Runtime的引用；然后您可以编写使用 FileSystemObject 的代码，如下所示：

Dim FSO As New Scripting.FileSystemObject
If Not FSO.FolderExists(xFilePath) Then
    FSO.CreateFolder xFilePath

End If

并参考Microsoft VBScript 正则表达式 5.5库：

Set xRegEx As New VBScript_RegExp_55.RegExp
xRegEx.Global = True
xRegEx.IgnoreCase = False
xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

If objItem.Class = olMail Then
    Set xMailItem = objItem
    xFileName = xRegEx.Replace(xMailItem.Subject, "")
    xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML

End If

推荐阅读