Dir通过文件夹中的.msg文件生成编译错误循环

时间:2018-11-08 04:12:45

标签: excel vba outlook

我有一个电子邮件文件文件夹,我正在尝试使用Dir从中提取发件人详细信息。我需要帮助确定为什么以下代码无法编译。

Sub UpdateReturns()
    Dim fso As Object, fld As Object, olApp As Object, MailFile As Object, MsgDetail As Object
    Dim stSearch As String, stPath As String, stFile As String, EmailFrom As String

    stPath = "C:\010. Working Docs"
    stSearch = "Approve"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(stPath)
    Set olApp = CreateObject("Outlook.Application")

    MailFile = Dir(stPath & "\*.msg")
    Do While MailFile <> ""
        Set MailFile = olApp.Session.OpenSharedItem(MailFile)
        Set MsgDetail = Application.ActiveInspector.CurrentItem
        EmailFrom = MsgDetail.SenderEmailAddress
        Sheets("Settings").Cells(41, 4).Value = EmailFrom
        'need to insert standard code to itterate down the list
        'and match sender names to recipient names and votes ("Approve") etc
    Loop
End Sub

2 个答案:

答案 0 :(得分:0)

我最终找到了解决之道。我只是用Outlook控件旋转轮子,所以我决定使用我更了解的东西,最终结果是我将其设置为从保存文件夹中读取,其中文件另存为文本文件,并且我有一个公式搜索的文件的内容会下降,以使其与已发送的电子邮件相匹配。

$L = (Get-WindowsOptionalFeature -Online | where FeatureName -eq Printing- 
Foundation-LPDPrintService)
$M = (Get-WindowsOptionalFeature -Online | where FeatureName -eq Printing- 
Foundation-LPRPortMonitor)
if ($L.state -eq "disabled"){enable-windowsoptionalfeature -Online - 
FeatureName "Printing-Foundation-LPDPrintService"}
if ($M.state -eq "disabled"){enable-windowsoptionalfeature -Online - 
FeatureName "Printing-Foundation-LPRPortMonitor"}

答案 1 :(得分:0)

Dir返回代表文件名的字符串。

Sub UpdateReturns()

    Dim fso As Object
    Dim fld As Object
    Dim olApp As Object

    Dim MailFile As Object
    Dim MailFileStr As String
    Dim MailPathFileStr As String

    Dim stPath As String
    Dim EmailFrom As String

    stPath = "C:\010. Working Docs"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(stPath)

    Set olApp = CreateObject("Outlook.Application")

    MailFileStr = Dir(stPath & "\*.msg")

    ' file name only, no path
    Debug.Print "MailFileStr: " & MailFileStr

    Do While MailFileStr <> ""

        ' path and file
        MailPathFileStr = stPath & "\" & MailFileStr
        Debug.Print vbCr & "MailPathFileStr: " & MailPathFileStr
        Set MailFile = olApp.Session.OpenSharedItem(MailPathFileStr)

        EmailFrom = MailFile.SenderEmailAddress
        Debug.Print "EmailFrom: " & EmailFrom

        Set MailFile = Nothing

        MailFileStr = Dir    ' Get next entry.

    Loop

End Sub