Question

所以我只想打开word文档，然后获取它们的值，但它似乎不起作用并且一直冻结我的excel。

任何人都知道我该做什么？我试图循环通过一个文件目录，然后打开每个文件并用它做事

    Public i As Long

Sub loopDir()

Dim file As Variant

   directory = "D:\Exceloplossing\ZRM\"
   file = Dir(directory & "*.docx")
   Do While (file <> "")
      Call transfer(directory & file)
     file = Dir
Loop
End Sub

Sub transfer(file As String)

    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim wb As Workbook
    Dim wsZRM As Worksheet
    Dim wsZRMSCORE As Worksheet

    Set wb = ThisWorkbook
    Set wsZRM = wb.Sheets(1)
    Set wsZRMSCORE = wb.Sheets(2)

    Application.ScreenUpdating = False

    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Open(file, AddToRecentFiles:=False, Visible:=False, ReadOnly:=False)
    'Debug.Print objDoc.FormFields(91).Result
    On Error GoTo Ending






    'ZRM invullen
   Row = lastRowInUse("A")
    'ZRM ID = BESTANDSNAAM:
    wsZRM.Cells(Row, 1) = filename
    'KLANT_ID = BSN:
    wsZRM.Cells(Row, 2) = "d"
    'SAVEDATE = DATUM_ZRM:
    wsZRM.Cells(Row, 3) = "d"




    objDoc.Close SaveChanges:=False
    objWord.Quit
    Set objDoc = Nothing: Set objWord = Nothing: Set ws = Nothing
    Application.ScreenUpdating = True

Ending:
objDoc.Close SaveChanges:=False
    objWord.Quit
    Set objDoc = Nothing: Set objWord = Nothing: Set ws = Nothing
    Application.ScreenUpdating = True


End Sub
Function lastRowInUse(col As String) As Long

        Dim lastRow As Long
        With ActiveSheet
            lastRow = ActiveSheet.Cells(1048576, col).End(xlUp).Row
        End With

        lastRowInUse = lastRow + 1

End Function

Answer 1

对我来说很明显：

file = Dir(directory & "*.docx")
Do While (file <> "")
   Call transfer(directory & file)
   file = Dir
Loop

除非我遗漏某些内容，否则Dir永远不会被设置为其他任何内容，因此您的循环将永远运行。

认为你想要file = Dir()

Answer 2

可能存在很多原因。以下是最明显的两个：

原因1 ：您没有Option Explicit，并且您的代码无法编译。写下来，编译并检查每个问题。

原因2 ：您忘记在Exit Sub之前写下Ending:：

  objDoc.Close SaveChanges:=False
    objWord.Quit
    Set objDoc = Nothing: Set objWord = Nothing: Set ws = Nothing
    Application.ScreenUpdating = True

Ending:
    objDoc.Close SaveChanges:=False
    objWord.Quit
    Set objDoc = Nothing: Set objWord = Nothing: Set ws = Nothing
    Application.ScreenUpdating = True

End Sub

因此，您的代码会再次通过Ending:。它无法关闭仍然关闭的东西。因此，你得到一个错误（但不是无限循环，正如我最初想的那样）。这是一种可行的方法：

    Application.ScreenUpdating = True
    On error goto 0
    Exit sub

Ending:
    on error resume next
    objDoc.Close SaveChanges:=False
    objWord.Quit
    Set objDoc = Nothing: Set objWord = Nothing: Set ws = Nothing
    Application.ScreenUpdating = True
    on error goto 0
End Sub

为什么我的vba代码会冻结？

2 个答案: