Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/24.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
为什么编译错误?excel vba对outlook的引用_Excel_Vba - Fatal编程技术网

为什么编译错误?excel vba对outlook的引用

为什么编译错误?excel vba对outlook的引用,excel,vba,Excel,Vba,此“archiveOutlookFolder”代码工作正常,直到我运行其他代码删除/重新添加对outlook的引用。卸载/加载Outlook后,objFolder.MoveTo objDestFolder行出现编译错误 我必须卸载/加载Outlook,因为办公室里不同的人有不同版本的Outlook。因此,为了防止错误,如果工作簿加载了版本,则卸载该版本,然后加载用户的版本 重申:卸载/加载Outlook后,我开始在“archiveOutlookFolder”子目录的“objFolder.Move

此“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

我没有在Outlook中对此进行测试,但是对您的
archiveOutlookFolder
子文件夹进行了一些更改。由于您对一些文件夹名称进行了硬编码,所以最好检查它们在设置期间是否变为空,如果没有,您可能希望让用户选择一个文件夹

关于
如果InStr(olFolder.Name,PNAToMove)>0则
,这意味着您希望在Outlook文件夹名的某些部分包含PNAToMove的值时执行某些操作

Private Const olFolderInbox = 6

Private Sub archiveOutlookFolder()

    Const AA_FOLDER As String = "Audits-Actuals"
    Const DEST_FOLDER As String = "PAST Audits-Actuals"

    On Error GoTo errhandler

    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 ' Folder
    Dim AAfolderToMove As String
    Dim PNAToMove As String
    Dim eventFolderTomove As String
    Dim foundEventFolder As Boolean

    Dim olAAfolders As Object ' Outlook.Folder
    Dim olFolder As Object ' 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 objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) ' <-- Make use of this!
    'Set olAAfolders = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Audits-Actuals")
    Set olAAfolders = objSourceFolder.Parent.Folders(AA_FOLDER) ' ("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 Not foundEventFolder Then ' 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) ' Moved this up!
    'Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Audits-Actuals").Folders(eventFolderTomove)
    Set objFolder = objSourceFolder.Parent.Folders(AA_FOLDER).Folders(eventFolderTomove)
    'Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("PAST Audits-Actuals")
    Set objDestFolder = objSourceFolder.Parent.Folders(DEST_FOLDER)

   If Not (objFolder Is Nothing And objDestFolder Is Nothing) Then 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
私有子archiveOutlookFolder()
Const AA_文件夹为String=“审计实际值”
Const DEST_文件夹为String=“过去的审核实际值”
关于错误转到错误处理程序
Dim objOutlook作为对象的Outlook.Application
将objNamespace设置为对象的Outlook.Namespace
Dim objSourceFolder作为对象的Outlook.MAPIFolder
将objDestFolder设置为对象的Outlook.MAPIFolder
Dim objFolder作为“对象”文件夹
Dim AAfolderToMove作为字符串
Dim PNA作为字符串移动
Dim eventFolderTomove作为字符串
将foundEventFolder设置为布尔值
将olAAfolders设置为对象的Outlook.Folder
将文件夹设置为对象的Outlook.Folder
PNAToMove=ThisWorkbook.Sheets(“数据”).Range(“cleanpna”).Value
出错时继续下一步
Set objOutlook=GetObject(,“Outlook.Application”)
错误转到0
如果objOutlook什么都不是,那么
设置objOutlook=CreateObject(“Outlook.Application”)
如果结束
设置objNamespace=objOutlook.GetNamespace(“MAPI”)
设置objSourceFolder=objNamespace.GetDefaultFolder(olFolderInbox)'0然后
eventFolderTomove=olFolder.Name
foundEventFolder=True
退出
如果结束
下一个文件夹
如果不是foundEventFolder,则“如果foundEventFolder=False,则
MsgBox“我找不到此事件的Outlook文件夹,无法移动到过去的事件。请手动移动。”,vbCritical,“审核\实际”
出口接头
如果结束
'Set objSourceFolder=objNamespace.GetDefaultFolder(olFolderInbox)'!
'设置objFolder=objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders(“审核实际值”).Folders(eventFolderTomove)
设置objFolder=objSourceFolder.Parent.Folders(AA_FOLDER).Folders(eventFolderTomove)
'Set objDestFolder=objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders(“过去的审计实际值”)
设置objDestFolder=objSourceFolder.Parent.Folders(DEST_FOLDER)
如果不是(objFolder为Nothing,objDestFolder为Nothing),则objFolder.MoveTo objDestFolder
Set objDestFolder=Nothing
设置objFolder=Nothing
设置objSourceFolder=Nothing
设置objOutlook=Nothing
Set objDestFolder=Nothing
出口接头
错误处理程序:
subName=“archiveOutlookFolder”
thisErrNum=错误编号
thisErrDes=错误描述
呼叫sendErrorAlert
端接头
工作代码:

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

编码完成后,将Outlook特定变量更改为
As Object
,这样您就无需引用,但请记住使用
Private Const
定义任何Outlook常量,例如
Private Const olFolderInbox=6
非常感谢您,@PatricK!这太棒了,我不需要推荐人!我试着设置为Const,但一定是我做错了什么吗?非常感谢你,@PatricK!这太棒了,我不需要推荐人!我尝试设置为Const,但我一定是做错了什么,因为“Const objOutlook as Object=Outlook.Application”给了我“变量未定义”,但我无法确定要使用哪个变量。我可以使用'Dim objOutlook As Object'&'Set objOutlook=GetObject(,'Outlook.Application'),但是我在'olFolderInbox'上得到了一个'variable not defined'&同样,我无法确定要使用哪个变量(对象和文件夹都会抛出不匹配错误)。你可以发布一个你的解决方案的例子让我看看吗?哦,我的意思是那些
Dim xxx作为Outlook.yyy
作为
Dim xxx作为Object
,以及那些以
ol
开头的内置常量。谢谢,@PatricK!(是,我想移动名称中包含PNAToMove值的Outlook文件夹)。我还是会犯同样的错误。(1) olFolderInbox=var未定义。我尝试了文件夹和对象,但两者都不匹配。(2) objFolder.MoveTo=未找到编译错误/方法或数据成员。我试图手动恢复引用,只是想看看它是否会工作,但没有。有什么想法吗?再次感谢你在这方面的帮助。我错过了olFolderInbox的const声明,并修复了它,对此表示抱歉!现在我只是在.moveto@patricKHmm上得到编译错误。。。在这一行“Set objFolder=objSourceFolder.Parent.Folders(AA_FOLDER.Folders(eventFolderTomove)”@patricKI也发现了错误13/类型不匹配。。。objFolder需要声明为对象而不是文件夹。。。修复了这两个错误。您可能希望在以后的所有编码中开始使用
选项Explicit
。在VBE中,工具->选项,编辑器选项卡,代码设置,勾选需要变量声明。