0

    VBE で [ツール] > [オプション] > [全般] > [エラー トラップ] を既に確認しました。「クラス モジュールで中断」と「未処理のエラーで中断」の両方に設定しましたが、いずれにしてもエラーがスローされます。エラーは次の行でスローされます。

Set xlContacts = Workbooks(LocalContactsFilename)

    添え字が範囲外であるというエラーがスローされます。これは、Workbooks コレクション内でインデックスが見つからなかったことを意味することを理解しています。通常、ファイルはアドインとして既に開かれているため、参照を取得できます。それはこの声明を通して。ファイルが開いていない場合は開くため、このエラーで再開することになっています。

    これについて気付いた奇妙な点の 1 つは、このコード行がリモート ファイルやネットワークにアクセスしていなくても、ネットワークから切断されている場合にのみこのエラーがスローされることです。ネットワークに接続しているときにワークブックを開くと、このエラーはスローされません。

    誰もこれを経験したことがありますか？オプションが未処理の例外でのみ停止するように設定されているが、それでも停止する場合は?

Public Sub openContactsFile()
    On Error Resume Next
    Dim fso As New FileSystemObject
    Dim LocalContactsPath As String
    Dim LocalContactsFilename As String
    Dim LocalContactsShortFilename As String

    LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
    LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
    LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))

    'On Error Resume Next
    Application.ScreenUpdating = False

    If Not fso.FileExists(LocalContactsPath) Then
        If MsgBox("The contacts file is not available.  Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
            SyncContacts
        Else
            GoTo cancelParse
        End If
    End If
    If fso.FileExists(LocalContactsPath) Then
        On Error GoTo catch_no_remote_connection
        If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
            If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
                SyncContacts
            End If
        End If
catch_no_remote_connection:
        If Err.Number = 53 Then Err.CLEAR
        On Error Resume Next
        Set xlContacts = Workbooks(LocalContactsFilename)

        If xlContacts Is Nothing Then
            Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
        End If
        xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    End If

    'hide the contacts from view or editing
    On Error Resume Next
    If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
    Err.CLEAR
    On Error GoTo 0
cancelParse:
    Application.ScreenUpdating = True
    Exit Sub
End Sub

これについて何か助けてくれてありがとう！

4

2 に答える 2

1

私はあなたと同じ（信じられないほど苛立たしい、説明できないと言うことができる限り）問題を抱えていましたが、別の状況でした。最善の方法は、回避策を見つけることです。あなたが持っているようにエラー処理を使用する代わりに、代わりにこれを使用してください：

Dim wb As Workbook, _
    xlContacts As Workbook

For Each wb In Application.Workbooks
    If wb.Name = LocalContactsFilename Then
        Set xlContacts = wb
        Exit For
    End If
Next wb

If xlContacts Is Nothing Then
    Set xlContacts = Workbooks.Open(LocalContactsPath, False, True
End If

あなたが行った方法でコーディングすることをお勧めしますが、選択の余地はないようです。

于 2013-01-25T01:48:12.223 に答える
0

@TimWilliams回答
    ありがとうございます-Err.CLEARはエラー処理をリセットすると思いましたが、そうではありません。以下のコードは、ネットワークに接続されているかどうかに関係なく正しく機能します（これが問題の原因であることがわかりました）。問題は、ファイルが見つからないというエラーをスローしてcatch_no_remote_connectionに移動したときに、エラーをクリアするための履歴書がなかったことです。そこで、これを追加して、エラー処理ブロックを閉じ、ハンドラーをリセットしました。

    Resume post_err
post_err:

 関数型コード：

Public Sub openContactsFile()
    On Error Resume Next
    Dim fso As New FileSystemObject
    Dim LocalContactsPath As String
    Dim LocalContactsFilename As String
    Dim LocalContactsShortFilename As String

    LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
    LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
    LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))

    Application.ScreenUpdating = False

    If Not fso.FileExists(LocalContactsPath) Then
        If MsgBox("The contacts file is not available.  Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
            SyncContacts
        Else
            GoTo cancelParse
        End If
    End If
    If fso.FileExists(LocalContactsPath) Then
        On Error GoTo catch_no_remote_connection
        If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
            If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
                SyncContacts
            End If
        End If
catch_no_remote_connection:
        'there is no network connection, clear the error and resume from here
        Err.CLEAR
        Resume post_err
post_err:
        On Error Resume Next
        'get reference to the workbook if it is already open
        Set xlContacts = Workbooks(LocalContactsFilename)

        If xlContacts Is Nothing Then
            'the workbook was not open, open it
            Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
        End If
        'sort contacts by company, name
        xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    End If

    'hide the contacts from view or editing by setting the workbook as an Addin
    On Error Resume Next
    If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
    Err.CLEAR
    On Error GoTo 0
cancelParse:
    Application.ScreenUpdating = True
    Exit Sub
End Sub

ご覧いただきありがとうございます！

于 2013-01-25T16:32:05.833 に答える