Hi everyone.
I need you help.
I have a problem with macro. Everything here works (export to word etc) but there are some things which require to be corrected. Below what I need.
1. Create a Folder in location and with the name from sheet [DocDataSource], cell M2
2. Use a template from path in cell B1 in sheet [DocDataSource]
3. Save in created folder updated template with data from Excel (it works) in docx, pdf, xlms with name from M3, sheet [DocDataSource]
Now I take a template from
but I would like to change and use a path from B1 sheet [DocDataSource] as I mentioned in point 2
I need you help.
I have a problem with macro. Everything here works (export to word etc) but there are some things which require to be corrected. Below what I need.
1. Create a Folder in location and with the name from sheet [DocDataSource], cell M2
2. Use a template from path in cell B1 in sheet [DocDataSource]
3. Save in created folder updated template with data from Excel (it works) in docx, pdf, xlms with name from M3, sheet [DocDataSource]
Now I take a template from
Code:
ThisWorkbook.Sheets("Path")
Code:
Sub SomeSub()
Dim r As Integer
Dim wdapp As Word.Application
Dim doc As Word.Document
Dim wkbCRMExt As Workbook
Dim wksCRMExt As Worksheet
'Dim sTargetFolder$
Set wkbCRMExt = Workbooks.Open(Environ("UserProfile") & "\Desktop\CRM.xlsx")
Set wksCRMExt = wkbCRMExt.Sheets(1)
'TargetFolder = Environ("UserProfile") & "\" & Sheets("DocDataSource").Range("M2").Value
'If Dir(sTargetFolder, vbDirectory) = "" Then MkDir sTargetFolder
Set wdapp = New Word.Application
wdapp.Visible = True
Set doc = wdapp.Documents.Open(Environ("UserProfile") & "\" & ThisWorkbook.Sheets("Path").Cells(1))
wdapp.ScreenUpdating = True
'For i = 1 To 1
'StrName = Environ("UserProfile") & "\" & Sheets("DocDataSource").Cells(i, "B").Value
'Set wdDoc = .Documents.Open(StrName)
'StrName = sTargetFolder & "\" & Cells(i, "F") & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")
'j = 0
ThisWorkbook.Worksheets("Excel").Range("A2:E24").Copy
doc.Bookmarks("Table2").Range.Paste 'ExcelTable False, True, False
For r = 1 To 5
doc.Bookmarks(wksCRM.Cells(r, "A").Value).Range.Text = wksCRMExt.Cells(r, "B").Value
Next r
'.SaveAs Filename:=StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
'.SaveAs Filename:=StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
End Sub