So I got the project working with opening the .dotx and inserting the values from the excel file and saving as .docx.
But I can't for the life of me get it to save as .pdf instead. Well I can, but the pdf can't be opened.
Sub Cost_Statement()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False
Application.ScreenUpdating = True
TemplateLocation = "C:\Custom documents\Cost_statement.dotx"
Set wrdDoc = wrdApp.Documents.Add(TemplateLocation, False, , False)
On Error GoTo NextNumber
cellno = "Main!C19"
FindText2 = "<<EXCELCOST>>"
ReplacementText2 = Range(cellno).Value
wrdDoc.Content.Find.Execute FindText2, ReplaceWith:=ReplacementText2, Replace:=wdReplaceAll
cellno = "Main!C20"
FindText3 = "<<EXCELDEST>>"
ReplacementText3 = Range(cellno).Value
wrdDoc.Content.Find.Execute FindText3, ReplaceWith:=ReplacementText3, Replace:=wdReplaceAll
NextNumber:
FileAddress = Range("Main!C21").Text
FileAddress = "C:\Cost Statement pdfs\" & FileAddress & ".docx"
With wrdDoc
.SaveAs (FileAddress)
.Close
End With
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
Any help would be appreciated.
Did you try this way?
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\PathPDF.pdf"
also note that
FileAddress = Range("Main!C21").Text
FileAddress = "C:\Cost Statement pdfs\" & FileAddress & ".docx"
is the same as
FileAddress = "C:\Cost Statement pdfs\" & FileAddress & ".docx"
Related
I was hoping to get some help. I have the following code that works on replacing text from a word documents with a certain word in excel. For example I have ClientName in a cell and the Cell next to it has John, so each time the word ClientName is found it is replaced with John and so on. Here is the code that works for word documents. Can it be altered to work for .pptx too?
Sub AutoContract()
Dim cell As Range
Dim rng As Range
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdDoc2 As Word.Document
Dim FilePath As String
Dim FilePath2 As String
Dim ending As String
Dim rngPara As Range
Dim Prompt As String
Dim Filesave As String
Dim FileSave2 As String
On Error GoTo ErrorHandler
Set wdApp = Nothing
FilePath = ThisWorkbook.Path
FilePath2 = Left(FilePath, InStr(FilePath, "\Calculations") - 1)
Filename = "Filename.docx"
StrDoc = FilePath2 & "\Inputs" & "\" & Filename
Set wdDoc2 = wdApp.Documents.Open(StrDoc)
Set rngPara = Range("A1:Z1058").Find("Variable Parameters")
If rngPara Is Nothing Then
MsgBox "Variable Parameters column was not found."
GoTo ErrorHandler
End If
Set rng = Range(rngPara, rngPara.End(xlDown))
wdApp.Visible = True
For Each cell In rng
If cell.Value = "" Then Exit For
With wdDoc2.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.Wrap = wdFindContinue
.Text = cell.Value
.Replacement.Text = cell.Offset(0, 1)
.Execute Replace:=wdReplaceAll
End With
Next
SaveAsName = Left(FilePath, InStr(FilePath, "\Calculations") - 1) & "\Outputs\" & Range("EmployName").Value & " " & Range("TodayDate").Value & " Contract" & ".docx"
wdDoc2.SaveAs2 SaveAsName
ErrorExit:
Set wdApp = Nothing
Exit Sub
ErrorHandler:
If Err.Number = 5174 Then
MsgBox "Please check the file name you specified is correct."
Resume ErrorExit
Else
MsgBox "Error No: " & Err.Number & "; There is a problem"
If Not wdApp Is Nothing Then
wdApp.Quit False
End If
Resume ErrorExit
End If
End Sub
I want to convert a list of text files in a particular folder into PDF.
I have written logic to open a single text file from Word document to be saved in a PDF format but it is not saved as a PDF file.
This is Excel VBA.
Dim file As Variant
inp_dir = "C:\Users\HP\OneDrive\Desktop\vbatest\pdfconv\"
inp_file_name = Dir(inp_dir & "*.txt") 'txt path
inp_file = inp_dir & inp_file_name
Dim wdApp As New Word.Application, wdDoc As Word.Document
MsgBox (inp_file)
' Set wdDoc = Documents.Open(inp_file)
Set wdDoc = Documents.Open(Filename:=inp_file, ReadOnly:=True, _
AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Visible:=False)
wdDoc.SaveAs2 Filename:="inp_file" & Replace(inp_file, ".txt", ".pdf"), _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False
I guess you are close - you just have a small mistake in your destination file name: You write Filename:="inp_file" & Replace(inp_file, ".txt", ".pdf"), but the fixed string "inp_file" makes no sense and invalidates the filename.
I always advice to use intermediate variables, with that it gets much easier to debug and to find errors.
Some more small things:
You should use Option Explicit and declare all variables.
You have a variable file declared that is never used.
declare your path as Constant
Your code could look like:
Const inp_dir = "C:\Users\HP\OneDrive\Desktop\vbatest\pdfconv\"
Dim inp_file_name As String, inp_full_name As String
inp_file_name = Dir(inp_dir & "*.txt") 'txt path
inp_full_name = inp_dir & inp_file_name
Dim wdApp As New Word.Application, wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Open(Filename:=inp_full_name, ReadOnly:=True, _
AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Visible:=False)
Dim pdf_Filename As String
pdf_Filename = Replace(inp_full_name, ".txt", ".pdf")
Debug.Print pdf_Filename
wdDoc.SaveAs2 Filename:=pdf_Filename, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False
wdApp.Quit
Your code is very close to running. Basically you need to open Word using your wdApp object. This example shows how...
Option Explicit
Sub TxtToPDF()
Dim inp_dir As String
Dim inp_file_name As String
Dim inp_file As String
inp_dir = "C:\Temp\"
inp_file_name = Dir(inp_dir & "*.txt") 'txt path
Dim wordWasRunning As Boolean
wordWasRunning = IsMSWordRunning
Dim wdApp As Word.Application
Set wdApp = AttachToMSWordApplication
Do While Len(inp_file_name) > 0
inp_file = inp_dir & inp_file_name
Debug.Print "currently opening " & inp_file
Dim wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Open(Filename:=inp_file, _
ReadOnly:=True, _
AddToRecentFiles:=False, _
Format:=wdOpenFormatAuto, _
Visible:=False)
Dim out_file As String
out_file = Replace(inp_file, ".txt", ".pdf")
Debug.Print "saving as " & out_file
wdDoc.SaveAs2 Filename:=out_file, _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False
'--- get the next txt file
inp_file_name = Dir
Loop
If Not wordWasRunning Then
wdApp.Quit
End If
End Sub
Put this code in another module to use (from my personal library).
Option Explicit
Public Function IsMSWordRunning() As Boolean
'--- quick check to see if an instance of MS Word is running
Dim msApp As Object
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- not running
IsMSWordRunning = False
Else
'--- running
IsMSWordRunning = True
End If
End Function
Public Function AttachToMSWordApplication() As Word.Application
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function
please could someone help me? I use mail merge and Word document as a template for labels. After execution of mail merge I need to show word print dialog for printer selection and to be able set label details in printer properties. I tried to set destination of mail merge to wdSendToPrinter , call dialog various ways e.g. wd.Dialogs(wdDialogFilePrint).Display but nothing works. Do you have any other suggestion, please?
Private Sub CommandButton1_Click()
Dim wdDoc, wd As Object
Dim template, excel As String, merge As String
template = ThisWorkbook.Path & "\template\templateA4.docx"
excel = ThisWorkbook.Path & "\" & ThisWorkbook.Name
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wd.documents.Open(template)
wdDoc.Application.Visible = False
wdDoc.MailMerge.OpenDataSource _
Name:=excel, _
AddToRecentFiles:=False, _
Revert:=False, _
Connection:="Data Source=" & excel & ";Mode=Read", _
SQLStatement:="SELECT * FROM `List1$`"
With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = 1
.LastRecord = 5
End With
.Execute Pause:=False
End With
merge = wdDoc.Application.activedocument.Name
wdDoc.Application.documents(template).Close wdDoNotSaveChanges
wdDoc.Application.Visible = True
wd.Application.documents(merge).Activate
'need to show word print dialog at this point
wdDoc.Application.ActiveDocument.PrintOut Background:=False
wdDoc.Application.ActiveDocument.Close wdDoNotSaveChanges
wdDoc.Close SaveChanges:=False
Set wdDoc = Nothing
wd.Application.Quit wdDoNotSaveChanges
Set wd = Nothing
End Sub
Try using wd.Dialogs(88).Show instead of wd.Dialogs(wdDialogFilePrint).Display
This function creates a word doc, saves and closes it, but is failing when I attempt to reopen. It says this at the remote call doesn't work. What is the proper practice for reopening a word doc? Or is it unnecessary to close and open again? It appears there is difficulty with communication between word and excel.
Sub tester()
Dim wordApp As Object
Dim wordDoc As Object
Dim appendDate As String
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
appendDate = "Y"
fName = "robot"
If appendDate = "Y" Or appendDate = "y" Then
fName = ThisWorkbook.Path & "\" & fName & "-" & Format(Now(), "yyyymmdd-hhmm") & ".docx"
Else
fName = ThisWorkbook.Path & "\" & fName & ".docx"
End If
wordApp.Documents.Add.SaveAs2 fileName:=fName
wordApp.Documents.Close
wordApp.Application.Quit
Set wordDoc = wordApp.Documents.Open(fileName:=fPath, readOnly:=False)
ThisWorkbook.Sheets("Sheet1").ChartObjects(1).Activate
ActiveChart.ChartArea.Copy
wordDoc.Application.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement:=wdInLine
End Sub
Since you quit the Word.Application then there's no more wordApp, so Documents.Open has no environment in which to execute.
If you want to open a file at any point, directly, without first starting the application you can use GetObject:
Set wordDoc = GetObject(FName)
If you need to address the Word.Application at a later point, after using GetObject to open the file:
Set wordApp = wordDoc.Application
This is how I would do it
Option Explicit
Const wdFormatXMLDocument As Integer = 12
Sub tester()
Dim wordApp As Object, wordDoc As Object
Dim appendDate As String, FName As String
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
appendDate = "Y"
FName = "robot"
If UCase(appendDate) = "Y" Then '<~~ Unsure of this as you are already setting the value of Y
FName = ThisWorkbook.Path & "\" & FName & "-" & Format(Now(), "yyyymmdd-hhmm") & ".docx"
Else
FName = ThisWorkbook.Path & "\" & FName & ".docx"
End If
Set wordDoc = wordApp.Documents.Add
ThisWorkbook.Sheets("Sheet1").ChartObjects(1).Activate
ActiveChart.ChartArea.Copy
wordApp.Selection.PasteSpecial Link:=False, DataType:=0, Placement:=0
wordDoc.SaveAs2 Filename:=FName, FileFormat:=wdFormatXMLDocument
wordDoc.Close (False)
wordApp.Quit
Set wordDoc = Nothing
Set wordApp = Nothing
End Sub
Screenshot
I have an excel sheet with data and want to export it to a new word document.
Is it possible to start MAIL MERGE from excel macro by clicking a button on the sheet?
If your Word document is already configured with the merge fields, and you are running the macro from the workbook that contains the data you want to merge into the Word document, then try this:
Sub RunMerge()
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdocSource = wd.Documents.Open("c:\test\WordMerge.docx")
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet1$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End Sub
To get dendarii's solution to work I had to declare Word constants in Excel VBA as follows:
' Word constants
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16
If your word document is already configured with data source and merge fields layout then it becomes much simpler. In the example below MailMergeLayout.doc is all setup ready to perform a merge. A button in Excel is linked to RunMailMerge() as below. All the code is contained in an Excel VBA module.
Sub RunMailMerge()
Dim wdOutputName, wdInputName As String
wdOutputName = ThisWorkbook.Path & "\Reminder Letters " & Format(Date, "d mmm yyyy")
wdInputName = ThisWorkbook.Path & "\MailMergeLayout.doc"
' open the mail merge layout file
Dim wdDoc As Object
Set wdDoc = GetObject(wdInputName, "Word.document")
wdDoc.Application.Visible = True
With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.Execute Pause:=False
End With
' show and save output file
wdDoc.Application.Visible = True
wdDoc.Application.ActiveDocument.SaveAs wdOutputName
' cleanup
wdDoc.Close SaveChanges:=False
Set wdDoc = Nothing
End Sub
Private Sub CommandButton1_Click()
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "C:\Documents and Settings\User\Desktop\mergeletter.doc"
wordapp.Visible = True
wrddoc = wordapp.documents("C:\Users\User\Desktop\sourceofletters.xls")
wrddoc.mailmerge.maindocumenttype = wdformletters
With wrddoc.activedocument.mailmerge
.OpenDataSource Name:="C:\Users\User\Desktop\sourceofletters.xls", _
SQLStatement:="SELECT * FROM `Sheet1`"
End With
End Sub
Above code is to open a word mailmerge document (with its source link and mergefield codes all setup ) all I want is for the message box "Opening the document will run the following SQL command " to be made available to the user , from that point forward the user could either select 'Yes' or 'No'.
Dim opt As String
opt = MessageBox("Opening the document will run the following SQL command", vbYesNo)
If opt = vbYes Then
'execute query
End If