Question

我的代码工作正常，直到我从2010年更改Office到2013年

此代码导出附件并运行一个脚本，该脚本在SQL Server中根据导出的文件插入信息文件未导出，没有Sql条目。没有生命。

'Addin for Outlook rules to export attachments to disk
'RAW Component of Outlook Attachment Strip
'Compiled by Muhammad Abubakar Riaz/COM/LHR to make life a lit bit easier

Sub RC_OutlookAttachmentStrip(anItem As Outlook.MailItem)

    Dim anAttachedObject As Outlook.Attachment

    'Location of folder you want to save attachments to

    Dim pathLocation As String
    pathLocation = "G:\FOI Files\Junk"

    'Date & time to add with attached file name

    nowDate = Format(Now, "dd-mm-yyyy")
    nowTime = Format(Now, "hh-mm AM/PM")

    'Random counter to minimize overwriting same file names in same folder

    randomCounter = CInt(Int((9999 * Rnd()) + 1))
    fileCounter = 0

    'Email received at

    receiveTime = anItem.ReceivedTime
    fromID = anItem.SenderName

    'SQL connection code

    Const adOpenStatic = 3
    Const adLockOptimistic = 3

    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordSet = CreateObject("ADODB.Recordset")

    objConnection.Open _
    "Provider = SQLOLEDB; " & _
        "Data Source=C-LHE-CS-68541\CMSA;" & _
        "Trusted_Connection=Yes;" & _
        "InitialCatalog=CMSA_Console;" & _
        "User ID=sa;Password=xxxxxxxxx;"

    '-------------------------
    'ended SQL Connection code

    'Save all files one by one

    For Each anAttachedObject In anItem.Attachments
        fileCounter = fileCounter + 1

        'fixed files types to be exported, like in this case it text files
        If Right(anItem.Attachments.Item(fileCounter).FileName, 4) = ".txt" Then

            'Save all files one by one
            'file format is 1-9999 Date Time OriginalFileName.extension
            anAttachedObject.SaveAsFile pathLocation & "\" & fileCounter & "-" & randomCounter & " " & nowDate & " " & nowTime & " " & anItem.Attachments.Item(fileCounter).FileName

            'create query String
            Myfilename = anItem.Attachments.Item(fileCounter).FileName
            sqlQuery = "Insert into [CMSATemp].[dbo].[temptest] Values('" & fromID & "','" & receiveTime & "','" & Myfilename & "')"

            'Insert records into DB
            objRecordSet.Open sqlQuery, _
            objConnection, adOpenStatic, adLockOptimistic

        End If    
        Set anAttachedObject = Nothing
    Next

    objConnection.Close

End Sub

Answer 1

我忘了调试很有用。我发现了一个逻辑错误 - 文件扩展名是.csv而不是.txt - 现在工作正常。

    'fixed files types to be exported, like in this case it text files
    If Right(anItem.Attachments.Item(fileCounter).FileName, 4) = ".csv" Then

如何使用Outlook规则从VBA插入行

1 个答案: