ADP
08-30-2017, 04:45 PM
Hello,
Following marco is conducted in Microsoft Word. VBA has three modules.
Module 1 opens windows explorer browser and prompts the user to select an excel file which is later used in Module 2. See code below.
Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
End If
End With
End Sub
Module 2 uses the file selected and performs a bulk find and replace function. This macro replaces some predefined words from a *.doc document with values of a cell from an excel-sheet. See Code below
Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = txtFileName
StrWkSht = "Protocol" 'or type Sheet1
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
If bStrt = True Then .Quit
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = False 'or True
.Wrap = wdFindContinue
.Text = Split(xlFList, "|")(i)
'.Execute
'To automatically change the found text:
'• comment-out/delete the previous line and the Do While Loop
'• uncomment the next two lines
.Replacement.Text = Split(xlRList, "|")(i)
.Execute Replace:=wdReplaceAll
End With
'Ask the user whether to change the found text
'Do While .Find.Found
'.Duplicate.Select
'Rslt = MsgBox("Replace this instance of:" & vbCr & _
'Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
'Split(xlRList, "|")(i), vbYesNoCancel)
'If Rslt = vbCancel Then Exit Sub
'If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
'.Collapse wdCollapseEnd
'.Find.Execute
'Loop
End With
Next
Application.ScreenUpdating = True
End Sub
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function
Module 3 calls Module 1 then Module 2. See code below.
Sub totalCall()
Call openDialog
Call BulkFindReplace
End Sub
After running Module 3, I get the following error message: "Excel Workbook is in Use. Please try again later." I made sure that the excel workbook is closed and also tried restarting the computer.
Could someone please help me with this? Thank you.
Following marco is conducted in Microsoft Word. VBA has three modules.
Module 1 opens windows explorer browser and prompts the user to select an excel file which is later used in Module 2. See code below.
Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
End If
End With
End Sub
Module 2 uses the file selected and performs a bulk find and replace function. This macro replaces some predefined words from a *.doc document with values of a cell from an excel-sheet. See Code below
Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = txtFileName
StrWkSht = "Protocol" 'or type Sheet1
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
If bStrt = True Then .Quit
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
If bFound = False Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = False 'or True
.Wrap = wdFindContinue
.Text = Split(xlFList, "|")(i)
'.Execute
'To automatically change the found text:
'• comment-out/delete the previous line and the Do While Loop
'• uncomment the next two lines
.Replacement.Text = Split(xlRList, "|")(i)
.Execute Replace:=wdReplaceAll
End With
'Ask the user whether to change the found text
'Do While .Find.Found
'.Duplicate.Select
'Rslt = MsgBox("Replace this instance of:" & vbCr & _
'Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
'Split(xlRList, "|")(i), vbYesNoCancel)
'If Rslt = vbCancel Then Exit Sub
'If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
'.Collapse wdCollapseEnd
'.Find.Execute
'Loop
End With
Next
Application.ScreenUpdating = True
End Sub
Function IsFileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
IsFileLocked = Err.Number
Err.Clear
End Function
Module 3 calls Module 1 then Module 2. See code below.
Sub totalCall()
Call openDialog
Call BulkFindReplace
End Sub
After running Module 3, I get the following error message: "Excel Workbook is in Use. Please try again later." I made sure that the excel workbook is closed and also tried restarting the computer.
Could someone please help me with this? Thank you.