运行时错误库在打开.doc文件时未注册

时间:2015-03-24 13:22:17

标签: vba excel-vba ms-word excel

我在excel vba中创建了一个宏来处理我需要从"源路径复制的文件列表"到目标路径"。复制时我还需要删除.doc文件的保护 一切都很好,但只在我的车站。当我在另外两个站点上尝试时,我收到以下错误消息:
"运行时错误' 2147319779(8002801d)'
自动化错误
图书馆未注册"
这是我已经检查的内容:我已经检查了Excel和Word中的VBA引用,它们是相同的。
从我在其他论坛上发现的可能是一些六角键问题,但我很害怕玩这个,而且提出的解决方案也没有用(我无法找到在问题站上有适当的注册码。) 我也试过添加一些延迟,但仍然没有运气

这是我的代码

    Sub copy_file_and_unprotect()

Dim ws As Worksheet
Dim wb As Workbook
Dim original_name As String
Dim copied_name As String
Dim WdApp As Object
Dim source_path As String
Dim target_path As String
Dim pwd As String

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Liste de vérification")             'where the original folder is stored
target_path = ws.Cells(1, 6) & "\Sections de devis type"

Set ws = wb.Worksheets("Nom des divisions")
source_path = ws.Cells(4, 5)                            'where the file will be copied
pwd = "cimaqc123"                                   'password to unprotect the file

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Plan de travail")
lig = 11
col = 26

Set WdApp = CreateObject("Word.Application")

While ws.Cells(lig, col) <> ""                          'loop to copy & unprotect a list of file
    num_sec = ws.Cells(lig, col)
    nom_sec = ws.Cells(lig, col + 2)
    file_name = num_sec & " - " & nom_sec & ".doc"            'name of the original file to be copied

    F = Dir(source_path & "\" & "*.doc")      'loop to search thru the source file for the file "file_name"
    Do While Len(F) > 0
        If F = file_name Then                     '
            original_name = source_path & "\" & F                     'path and name of file to be copied
            copied_name = target_path & "\" & file_name                'path and name of new file to be unlocked later on
            FileCopy original_name, copied_name                         'copying of the file

'-----THIS IS WHERE I GET THE ERROR MESSAGE AFTER THE FOLLOWING LINE-----
            Set WdApp = Documents.Open(copied_name)
            If Not WdApp.ProtectionType = -1 Then                   'unprotect the file
                 WdApp.Unprotect pwd
                 WdApp.Close True
            Else
                WdApp.Close True
            End If
            GoTo file_copied:
        End If
        F = Dir()
    Loop
file_copied:
    lig = lig + 1                        'on passe à la prochaine section de devis

Wend

End Sub

有没有人可以分享一些关于此的事情?如何解决我收到的错误消息?

1 个答案:

答案 0 :(得分:0)

在@KenWhite的帮助下,此处更新的代码已解决错误

Sub copy_file_and_unprotect()

Dim ws As Worksheet
Dim wb As Workbook
Dim original_name As String
Dim copied_name As String
Dim WdApp As Object
Dim WdDoc As Object
Dim source_path As String
Dim target_path As String
Dim pwd As String

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Liste de vérification")             'where the original folder is stored
target_path = ws.Cells(1, 6) & "\Sections de devis type"

Set ws = wb.Worksheets("Nom des divisions")
source_path = ws.Cells(4, 5)                            'where the file will be copied
pwd = "cimaqc123"                                   'password to unprotect the file

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Plan de travail")
lig = 11
col = 26

Set WdApp = CreateObject("Word.Application")

While ws.Cells(lig, col) <> ""                          'loop to copy & unprotect a list of file
    num_sec = ws.Cells(lig, col)
    nom_sec = ws.Cells(lig, col + 2)
    file_name = num_sec & " - " & nom_sec & ".doc"            'name of the original file to be copied

    F = Dir(source_path & "\" & "*.doc")      'loop to search thru the source file for the file "file_name"
    Do While Len(F) > 0
        If F = file_name Then                     '
            original_name = source_path & "\" & F                     'path and name of file to be copied
            copied_name = target_path & "\" & file_name                'path and name of new file to be unlocked later on
            FileCopy original_name, copied_name                         'copying of the file

'----------------LINE BELOW IS WHERE IT WAS CAUSING PROBLEM -------------------------
            Set WdDoc = WdApp.Documents.Open(copied_name)       'line that was add
            'Set WdApp = Documents.Open(copied_name)            'line that was removed
            If Not WdDoc.ProtectionType = -1 Then                   'unprotect the file
                 WdDoc.Unprotect pwd                                'replaced WdApp by WdDoc
                 WdDoc.Save
                 WdDoc.Close True
            Else
                WdDoc.Close True
            End If
            GoTo file_copied:
        End If
        F = Dir()
    Loop
file_copied:
    lig = lig + 1
Wend

End Sub
相关问题