Question

我起草了一个代码，将数据从Word文件提取到Excel工作表中。但是，它仅在用户选择单个文件时起作用。当用户一次进行多项选择时，有没有办法允许代码运行？我的意思是我们可以让用户选择多个Word文件并在所有选定的文件上运行代码吗？

以下是我的代码：子getWordFormData（）

Dim wdApp As Object, myDoc As Object, WS As Worksheet

Dim myFolder As String  

Dim i As Long, j As Long, lrow As Long, fname As String

Set WS = Worksheets("FAILURE LOG")

lrow = WS.Cells(Rows.Count, 4).End(xlUp).Row + 1

MsgBox (lrow)

Dim intChoice As Integer

Dim strPath As String 
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Word Files Only", "*.docx")
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select a File to Open "
.InitialFileName = "" 
    'make the file dialog visible to the user
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    
     'determine what choice the user made
    If intChoice <> 0 Then
   
    'get the file path selected by the user    
    strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    MsgBox (strPath)
Else
    MsgBox ("No File Selected")
    Exit Sub       
End If
End With

' myFolder = "C:\Users\aabyouki\Desktop\NCMR"
    
'If Len(Dir(myFolder)) = 0 Then
'MsgBox myFolder & vbCrLf & "Not Found", vbInformation, "Cancelled - getWordFormData
'Exit Sub
'End If
Application.ScreenUpdating = False
Set wdApp = CreateObject("Word.Application")
With ActiveSheet
.Cells.Clear
 With .Range("D1:T1")
.Value = Array("Failure Date", "RWS #", "Failed Assy.", "Failed ASSY PN", "Failed ASSY SN", "Failed Component", "Failed Component PN", _
"Failed Component SN", "Quantity", "UOM", "Failure Stage", "Failure Type", "JC Number", "Failed Component Supplier", "Failure Description", "NC Report", "Reported By")
.Font.Bold = True
 End With
       ' i = 1
        'While strFile <> ""
         '   i = i + 1
         
Set myDoc = wdApp.Documents.Open(Filename:=strPath, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
'Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
MsgBox (myDoc)
            
            .Cells(lrow, 4).Value = myDoc.SelectContentControlsByTag("FDate").Item(1).Range.Text
            .Cells(lrow, 5).Value = myDoc.SelectContentControlsByTag("RWS").Item(1).Range.Text
            .Cells(lrow, 6).Value = myDoc.SelectContentControlsByTag("FASSY").Item(1).Range.Text
            .Cells(lrow, 7).Value = myDoc.SelectContentControlsByTag("ASSYPN").Item(1).Range.Text
            .Cells(lrow, 8).Value = myDoc.SelectContentControlsByTag("ASSYSN").Item(1).Range.Text
            .Cells(lrow, 9).Value = myDoc.SelectContentControlsByTag("FC").Item(1).Range.Text
            .Cells(lrow, 10).Value = myDoc.SelectContentControlsByTag("FCPN").Item(1).Range.Text
            .Cells(lrow, 11).Value = myDoc.SelectContentControlsByTag("FCSN").Item(1).Range.Text
            .Cells(lrow, 12).Value = myDoc.SelectContentControlsByTag("QTY").Item(1).Range.Text
            .Cells(lrow, 13).Value = myDoc.SelectContentControlsByTag("UOM").Item(1).Range.Text
            .Cells(lrow, 14).Value = myDoc.SelectContentControlsByTag("FSTAGE").Item(1).Range.Text
            .Cells(lrow, 15).Value = myDoc.SelectContentControlsByTag("FTYPE").Item(1).Range.Text
            .Cells(lrow, 16).Value = myDoc.SelectContentControlsByTag("JCN").Item(1).Range.Text
            .Cells(lrow, 17).Value = myDoc.SelectContentControlsByTag("Vendor").Item(1).Range.Text
            .Cells(lrow, 18).Value = myDoc.SelectContentControlsByTag("FDescription").Item(1).Range.Text
            .Cells(lrow, 19).Value = myDoc.SelectContentControlsByTag("NC").Item(1).Range.Text
            .Cells(lrow, 20).Value = myDoc.SelectContentControlsByTag("Originator").Item(1).Range.Text
            
            myDoc.Close SaveChanges:=False
            Range("D:T").WrapText = True
            'strFile = Dir()
        'Wend
wdApp.Quit               
Application.ScreenUpdating = True
End With
End Sub

允许用户选择多个文件

0 个答案: