Excel to Word doc / File Patch -> cell

beczer

New Member
Joined
Nov 21, 2016
Messages
49
Hi there

I am not advanced Vba programmer and I need your help. Could please review my code and tell how to change the DOC(template) file path ? In other words, I would like to use 3 different word templates so I can't put file path in VBA code as it is. I need to put a reference to cell where there is a file path.
A1 - C:\Users\Tom\Desktop\doc1.docx
A2 - C:\Users\Tom\Desktop\doc2.docx
A3 - C:\Users\Tom\Desktop\doc1.docx

Another thing, I would also like to add a possiblity to save DOCs and PDFs in created folder by VBA.

My current VBA code:

Code:
Sub CreateWordTemplate()




    Dim wdApp As Word.Application
    Dim SaveName As String
    Dim FileExt As String
    Set wdApp = CreateObject("Word.Application")


    With wdApp
        '.Visible = True
        '.Activate
        
        .Documents.Add "C:\Users\name\Desktop\doc1.docx"




    Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
        
    
    .Selection.GoTo What:=-1, Name:="bookmark1"
    .Selection.PasteSpecial


FileExt = ".pdf"
                            
                 SaveName = Environ("UserProfile") & "\Desktop\doc1.docx " & _
        Format(Now, "yyyy-mm-dd hh-mm-ss") & ".pdf"




                .ActiveDocument.ExportAsFixedFormat OutputFileName:=SaveName, ExportFormat:=17
              
        
       SaveName = Environ("UserProfile") & "\Desktop\doc1.docx " & _
        Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx"




    If .Version <= 12 Then
        .ActiveDocument.SaveAs SaveName
    Else
    .ActiveDocument.SaveAs2 SaveName
    End If


    .ActiveDocument.Close
    .Quit


    End With


    Set wdApp = Nothing
End Sub
Thank you in advance !!!

Tomasz
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Sektor

Well-known Member
Joined
May 6, 2011
Messages
2,834
Code:
Dim rng As Range
Set rng = Range("A1:A3")
....
.Documents.Add rng(1) 'A1
'.Documents.Add rng(2) 'A2
'.Documents.Add rng(3) 'A3
 

beczer

New Member
Joined
Nov 21, 2016
Messages
49
Hi Sektor, thanks for quick reply. Unfortunately it doesn't work. I think I did something wrong. Could you pls take a look ?

Sub CreateBasicWordReport()


Code:
    Dim wdApp As Word.Application
    Dim SaveName As String
    Dim FileExt As String
    Dim rng As Range
    Set rng = Range("A1:A3")
    Set wdApp = CreateObject("Word.Application")


    With wdApp
        '.Visible = True
        '.Activate
        
        .Documents.Add rng(1) 'A1
        .Documents.Add rng(2) 'A2
        .Documents.Add rng(3) 'A3
 

Sektor

Well-known Member
Joined
May 6, 2011
Messages
2,834
Oh, uncomment lines:
Code:
[COLOR=#333333]'.Visible = True[/COLOR]
[COLOR=#333333]'.Activate[/COLOR]
;)
 

beczer

New Member
Joined
Nov 21, 2016
Messages
49
Sektor, I'm really gratefull for your support but it still doesn't work :((
 

Sektor

Well-known Member
Joined
May 6, 2011
Messages
2,834
I am sorry for not carefully reading your post. You're talking about templates rather documents. Templates have extensions DOTX (macro-free) and DOTM (with macro) and DOT (for Word < 2007). As I see, you have DOCX file extension - which is not template but rather ordinary document.
 

beczer

New Member
Joined
Nov 21, 2016
Messages
49
Yes I know but it is not a problem. I changed it before so it is fine. Anyway it still doesn't work :(

VBA error -> .Documents.Add rng(1) 'A1
 

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,445
beczer: there are numerous problem with your code, but I guess you knew that already.

One thing that isn't clear is why you're using the Documents.Add method for an existing document instead of using it for a template or, alternatively, why you're not using the Documents.Open method for the existing document.

Another oddity is your retention of the .docx extension in the middle of the output filenames - for both the document and the pdf.

You also refer to saving the outputs to a folder created by VBA, which is quite possible, but you given no indication of how that folder's name might be determined.

Try the following code. It generates output files from your data in A1-A3.
Code:
Sub CreateWordOutputs()
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim xlWkSht As Worksheet, StrName As String, i As Long
'Define our worksheet
Set xlWkSht = ActiveSheet
'Initialize Word
Set wdApp = CreateObject("Word.Application")
With wdApp
  'Loop through A1-A3 for our filenames
  For i = 1 To 3
    StrName = xlWkSht.Range("A" & i).Value
    'Open the file
    Set wdDoc = .Documents.Open(StrName)
    'Reconfigue the filename for output usage
    StrName = Split(StrName, .docx)(0) & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")
    'Get our data
    xlWkSht.Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
    With wdDoc
      'Add the data to our document
      .Bookmarks("bookmark1").Range.Paste
      'Save our document as both a Word document and as a PDF
      .SaveAs Filename:=StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
      .SaveAs Filename:=StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      'Close our file without re-saving
      .Close False
    End With
  Next
  'Exit Word
  .Quit
End With
'Cleanup
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,101,748
Messages
5,482,616
Members
407,354
Latest member
Calvince

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top