为什么编译出错？excel vba 参考 Outlook

debugcn 发表于 Dev

乔帕特里克

这个“archiveOutlookFolder”代码可以正常工作，直到我运行其他删除/重新添加对 Outlook 的引用的代码。卸载/加载 Outlook 后，我在 objFolder.MoveTo objDestFolder 行上收到编译错误。

我必须卸载/加载 Outlook，因为不同的人在整个办公室拥有不同版本的 Outlook。因此，为了防止错误，如果工作簿加载了版本，则将其卸载，然后加载用户的版本。

重申：卸载/加载 Outlook 后，我开始在“archiveOutlookFolder”子的“objFolder.MoveTo objDestFolder”行上收到编译错误。

任何解决此问题的帮助将不胜感激。谢谢！

Private Sub LoadOutlook()

Application.Run "UnloadOutlook"

    On Error GoTo unable2Load

    ThisWorkbook.VBProject.References.AddFromFile "MSOUTL.OLB"

    Exit Sub

unable2Load:

If Err.Number = 32813 Then Exit Sub

If Err.Number = 48 Then'for some reason 16 won't load without specific reference
ThisWorkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Microsoft Office\Office16\MSOUTL.OLB"
Exit Sub
End If

    MsgBox err.number & vblf & vblf & err.description

End Sub

Private Sub UnloadOutlook()

    On Error GoTo unable2Unload

    Dim References As Object
    Set References = ThisWorkbook.VBProject.References
    References.Remove References("Outlook")

    Exit Sub

unable2Unload:

If Err.Number = 9 Then Exit Sub 'already unloaded

MsgBox err.number & vblf & vblf & err.description

End Sub


Private Sub archiveOutlookFolder()

on error goto errHandler

Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objFolder As Folder
Dim AAfolderToMove As String
Dim PNAToMove As String
Dim eventFolderTomove As String
Dim foundEventFolder As Boolean

Dim olAAfolders As Outlook.Folder
Dim olFolder As Outlook.Folder

PNAToMove = ThisWorkbook.Sheets("data").Range("cleanpna").Value

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
    Set objOutlook = CreateObject("Outlook.Application")
End If

Set objNamespace = objOutlook.GetNamespace("MAPI")
Set olAAfolders = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Audits-Actuals")

foundEventFolder = False

For Each olFolder In olAAfolders.Folders
    If InStr(olFolder.Name, PNAToMove) > 0 Then
    eventFolderTomove = olFolder.Name
    foundEventFolder = True
    Exit For
    End If
Next olFolder

If foundEventFolder = False Then
MsgBox "I did not find an Outlook folder for this event to move to Past events. Please move manually.", vbCritical, "Audits\Actuals"
Exit Sub
End If

   Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
   Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Audits-Actuals").Folders(eventFolderTomove)
   Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("PAST Audits-Actuals")

   objFolder.MoveTo objDestFolder

   Set objDestFolder = Nothing
   Set objFolder = Nothing
   Set objSourceFolder = Nothing
   Set objOutlook = Nothing
   Set objDestFolder = Nothing

   Exit Sub

errhandler:

subName = "archiveOutlookFolder"
thisErrNum = Err.Number
thisErrDes = Err.Description

Call sendErrorAlert

End Sub

乔帕特里克

工作代码：

Private Const olFolderInbox = 6

Private Sub archiveOutlookFolder()

On Error GoTo errhandler

Dim AA_FOLDER As String
Dim DEST_FOLDER As String

AA_FOLDER = "Audits-Actuals"
DEST_FOLDER = "PAST Audits-Actuals"

Dim objOutlook As Object ' Outlook.Application
Dim objNamespace As Object ' Outlook.Namespace
Dim objSourceFolder As Object ' Outlook.MAPIFolder
Dim objDestFolder As Object ' Outlook.MAPIFolder
Dim objFolder As Object ' Outlook.Folder
Dim olAAfolders As Object ' Outlook.Folder
Dim olFolder As Object ' Outlook.Folder

Dim AAfolderToMove As String
Dim PNAToMove As String
Dim eventFolderTomove As String
Dim foundEventFolder As Boolean

PNAToMove = ThisWorkbook.Sheets("data").Range("cleanpna").Value

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo errhandler
If objOutlook Is Nothing Then
    Set objOutlook = CreateObject("Outlook.Application")
End If

tryAgain:
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set olAAfolders = objSourceFolder.Parent.Folders(AA_FOLDER)

foundEventFolder = False

For Each olFolder In olAAfolders.Folders
    If InStr(olFolder.Name, PNAToMove) > 0 Then
        eventFolderTomove = olFolder.Name
        foundEventFolder = True
        Exit For
    End If
Next olFolder

If Not foundEventFolder And AA_FOLDER = "Audits-Actuals" Then
AA_FOLDER = "PAST Audits-Actuals"
DEST_FOLDER = "Audits-Actuals"
GoTo tryAgain
End If

If Not foundEventFolder Then
MsgBox "I did not find an Outlook folder for this event to move automatically. Please move manually.", vbCritical, "Audits\Actuals"
Exit Sub
End If

Set objFolder = objSourceFolder.Parent.Folders(AA_FOLDER).Folders(eventFolderTomove)
Set objDestFolder = objSourceFolder.Parent.Folders(DEST_FOLDER)

If Not (objFolder Is Nothing And objDestFolder Is Nothing) Then objFolder.MoveTo objDestFolder

Set olAAfolders = Nothing
Set objNamespace = Nothing
Set objDestFolder = Nothing
Set objFolder = Nothing
Set objSourceFolder = Nothing
Set objOutlook = Nothing

Exit Sub

errhandler:

MsgBox Err.Number & vbLf & Err.Description

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。