Vba 将CSV/Excel文件读入数组

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

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

我想我能想出大部分方法（嵌套if和for语句的巧妙组合），但我不能想出如何将文件读入数组，我的googlefu让我失望了

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

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

选项显式
Private，邮件中的事件作为Outlook.Items
子应用程序_启动（）
将xNameSpace设置为Outlook.NameSpace
设置xNameSpace=Outlook.Application.Session
设置InboxItems=xNameSpace.GetDefaultFolder（olFolderInbox）.Items
端接头
私有子InboxItems_ItemAdd（ByVal objItem作为对象）
模糊FSO
将xMailItem设置为Outlook.MailItem
将xFilePath设置为字符串
Dim xRegEx
Dim xFileName作为字符串
Dim SenderAddress作为字符串
出错时继续下一步
'将SenderAddress定义为发件人的电子邮件地址或域
xFilePath=PathCreator（发件人地址）
设置FSO=CreateObject（“Scripting.FileSystemObject”）
如果FSO.FolderExists（xFilePath）=False，则
FSO.CreateFolder（xFilePath）
如果结束
设置xRegEx=CreateObject（“vbscript.regexp”）
xRegEx.Global=True
xRegEx.IgnoreCase=False
xRegEx.Pattern=“\\\\\/\\\\\\\\\”“\：\*\ \ \ \ \ \ \ \ \？”
如果objItem.Class=olMail，则
设置xMailItem=objItem
xFileName=xRegEx.Replace（xMailItem.Subject，“”）
xMailItem.SaveAs xFilePath&“\”&xFileName&“.html”，olHTML
如果结束
出口接头
端接头
函数PathCreator（SenderAddress）
“[需要读取文件并根据值创建路径]
端函数

您可以使用ADODB连接到源文件，并将其读入二维数组。从工具中添加对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中，用户必须手动插入字段分隔符和行分隔符；对于任何其他文本格式也一样，用户必须记住格式的规则d正确地应用它们

---

但我怀疑数组是否是您使用的最佳数据结构；在这种情况下，您可以直接使用记录集。为了确保文件未保持打开状态，您可以使用断开连接的记录集。（如果您的目的是找到合适的域名并使用该域名获取其他详细信息，那么我建议您将数据从记录集中加载到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脚本运行时的引用；然后您可以编写使用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

将xRegEx设置为新的VBScript\u RegExp\u 55.RegExp
xRegEx.Global=True
xRegEx.IgnoreCase=False
xRegEx.Pattern=“\\\\\/\\\\\\\\\”“\：\*\ \ \ \ \ \ \ \ \？”
如果objItem.Class=olMail，则
设置xMailItem=objItem
xFileName=xRegEx.Replace（xMailItem.Subject，“”）
xMailItem.SaveAs xFilePath&“\”&xFileName&“.html”，olHTML
如果结束