ChrisATBAse
08-16-2019, 12:57 AM
Hi everyone,
New to coding so I would really appreciate the help.
I need help adjusting the macro below. I have a lot of template Word Documents that I need to make changes to and doing a macro for each file is very time consuming. Is there a way I can edit the macro below to let me select a folder path and loop through each of the files in the folder, make the change and save in new destination?
Sub Cement()
Dim wdApp As Word.Application
Dim Wks As Excel.Worksheet
Dim wdDoc As Word.Document
Dim myFile As String
Set Wks = ActiveSheet
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(Environ("UserProfile") & "\Google Drive\SMS TEMPLATES\04 COSHH\001 Cement.docx")
Call ReplaceWords2(wdDoc, Wks, False)
Call CopyPasteImage2(wdDoc, Wks, False)
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
Sub ReplaceWords2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)
Dim wdRng As Word.Range
Dim varTxt As Variant
Dim varRngAddress As Variant
Dim i As Long
varTxt = Split("an1,id1,rd1", ",")
varRngAddress = Split("C8,C5,C6", ",")
For Each wdRng In oDoc.StoryRanges
With wdRng.Find
For i = 0 To UBound(varTxt)
.Text = varTxt(i)
.Replacement.Text = Wks.Range(varRngAddress(i)).Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
Next i
End With
Next wdRng
oDoc.SaveAs2 Environ("UserProfile") & "\desktop\001 Cement.docx"
If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If
End Sub
Sub CopyPasteImage2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)
With oDoc
.Activate
.ActiveWindow.View = wdNormalView
Wks.Range("K2:L15").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Bookmarks("CompanyLogo").Select
.Parent.Selection.Paste
.Parent.Selection.TypeParagraph
.Save
If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If
End With
End Sub
New to coding so I would really appreciate the help.
I need help adjusting the macro below. I have a lot of template Word Documents that I need to make changes to and doing a macro for each file is very time consuming. Is there a way I can edit the macro below to let me select a folder path and loop through each of the files in the folder, make the change and save in new destination?
Sub Cement()
Dim wdApp As Word.Application
Dim Wks As Excel.Worksheet
Dim wdDoc As Word.Document
Dim myFile As String
Set Wks = ActiveSheet
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(Environ("UserProfile") & "\Google Drive\SMS TEMPLATES\04 COSHH\001 Cement.docx")
Call ReplaceWords2(wdDoc, Wks, False)
Call CopyPasteImage2(wdDoc, Wks, False)
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
Sub ReplaceWords2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)
Dim wdRng As Word.Range
Dim varTxt As Variant
Dim varRngAddress As Variant
Dim i As Long
varTxt = Split("an1,id1,rd1", ",")
varRngAddress = Split("C8,C5,C6", ",")
For Each wdRng In oDoc.StoryRanges
With wdRng.Find
For i = 0 To UBound(varTxt)
.Text = varTxt(i)
.Replacement.Text = Wks.Range(varRngAddress(i)).Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
Next i
End With
Next wdRng
oDoc.SaveAs2 Environ("UserProfile") & "\desktop\001 Cement.docx"
If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If
End Sub
Sub CopyPasteImage2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)
With oDoc
.Activate
.ActiveWindow.View = wdNormalView
Wks.Range("K2:L15").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Bookmarks("CompanyLogo").Select
.Parent.Selection.Paste
.Parent.Selection.TypeParagraph
.Save
If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If
End With
End Sub