I'm opening multiples Word doc to remove the protection in them.
So basically what my code is doing is that if user choose to enter a password then:
valeur = 6
and pwd is set to a specific value.
My problem is even if I do: set WdApp = nothing, it still won't release the winword.exe process.
Do While Len(F) > 0
If F = nom_fichier Then 'file name
nom_original = chemin & "\" & F 'path
nom_copie = repertoire_cible & "\" & nom_fichier 'copy of a file
nom_modifie = repertoire_cible & "\" & nom_en_preparation 'rename of file
If Dir(nom_original, vbDirectory) = vbNullString Then
GoTo fichier_non_trouve
End If
If Not Dir(nom_modifie, vbDirectory) = vbNullString Then GoTo fichier_deja_existant:
End If
FileCopy nom_original, nom_copie 'file copy
Name nom_copie As nom_modifie ' file rename
If valeur = 6 Then 'protection removal
Set WdApp = CreateObject("Word.Application")
Set WdApp = Documents.Open(nom_modifie)
If Not WdApp.ProtectionType = -1 Then WdApp.Unprotect pwd
WdApp.Close True
Else
WdApp.Close True
End If
Set WdApp = Nothing
End If
GoTo fichier_copier:
End If 'on copie le fichier dans le dossier en préparation
F = Dir()
Loop
So at this point since I called Set WdApp = nothing I don't see why it's not releasing the winword.exe.
Any kind help will be really appreciate
Keep a reference to the application and the doc independently and .Quit the application:
Set WdApp = CreateObject("Word.Application")
Set WdDoc = Documents.Open(nom_modifie)
... use wdDoc
WdDoc.close True
WdApp.Quit
But why not create WdApp outside the loop and open docs as needed, quitting the application when your done.
Related
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
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"
I have a problem with my code below. I created an userform in order to generate Word documents automatically which I prepared (I created a bunch of bookmarks).
It works really well on my computer but not on another computer and I really don't understand why. Both computers have the same Office version (1902) and I have activated the Microsoft Word 16.0 Object Library reference.
What I mean by "it's not working" it is that the Word document will open but no action will be Performed... And also I have not a single error message.
Private Sub BCO_Click()
Dim objWord As New Word.Application, wordDoc As Word.Document
'FCO is the userform and the subobjects are combobox entries.
If FCO.SOCIETENAME <> "" And FCO.NUMCO <> "" And FCO.ComboBox1 <> "" Then
Dim pathcovierge As String
Dim pathconew As String
'Path of the files needed there, copy from an existing (pathcovierge) to a new one (pathconex)
pathcovierge = path & "\Documents_Vierges\" & "CO.docx"
pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"
If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"
'If file already open, msgbox
On Error Resume Next
FileCopy pathcovierge, pathconew
If Err > 0 Then
MsgBox "Veuillez fermer CO.docx afin de générer un CO."
End If
'opening of the new word document
objWord.Visible = True
objWord.Documents.Open pathconew
Dim DocDest As Word.Document
Set DocDest = GetObject(pathconew)
'THIS IS NOT WORKING.
DocDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
DocDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
DocDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value
'Saving (working)
DocDest.SaveAs pathconew
AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")
On Error GoTo 0
Else
MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
End If
End Sub
I took a look in your code and made some changes (also see my comments in the code):
I enhanced the readability by early exiting the procedure instead of using 'arrow code'.
Now the opened Word document will be set to the variable immediately.
Your error handling suppressed all errors. I changed it, but you should add proper error handling though. Think about splitting your procedure in several separate procedures.
This should lead you to your result:
Private Sub BCO_Click()
If FCO.SOCIETENAME = "" Or FCO.NUMCO = "" Or FCO.ComboBox1 = "" Then
MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
Exit Sub
End If
Dim pathcovierge As String
pathcovierge = path & "\Documents_Vierges\" & "CO.docx"
Dim pathconew As String
pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"
If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"
'This seems to be the reason why you get no error:
On Error Resume Next
FileCopy pathcovierge, pathconew
If Err > 0 Then
MsgBox "Veuillez fermer CO.docx afin de générer un CO."
End If
'This will let you see a possible error, but you should think about implement a proper error handling though:
On Error Goto 0
Dim objWord As Word.Application
Set objWord = New Word.Application
objWord.Visible = True
Dim docDest As Word.Document
'If the problem was to get the handle to the opened document, this should work better:
Set docDest = objWord.Documents.Open(pathconew)
docDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
docDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
docDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value
docDest.SaveAs pathconew
AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")
End Sub
I am using a MAC and I'm trying to create a macro that will print a Word document from my Excel worksheet. The user does not need to see the word document, they just need to print it.
After looking through some of the previous questions answered in this forum I managed to write some code that worked on my PC at home.
However, I changed the file path and filename and copied the code to my MAC that I am using at work and the code no longer seems to work. I wonder if the code has to be different when using a MAC?
I am using Microsoft Excel for Mac 2011, version 14.6.8.
ans = MsgBox(Prompt:="Document 1", Buttons:=vbYesNo, Title:="Print")
If ans = vbYes Then
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
'Enter filename and path here
Set objDoc = objWord.Documents.Open("/Volumes/.../Document 1.docx")
objWord.Visible = False
objDoc.PrintOut
objWord.Quit
End If
Sometimes the code gets stuck at CreateObject("Word.Application") and sometimes the code get stuck where I have written the file path and filename.
I'm not entirely sure that I have written the file path correctly..?
Any help would be much appreciated.
Is your file on a network?
Use that code in Word VBE to get the path of your file in the immediate window :
Sub get_path()
Debug.Print ActiveDocument.Path
End Sub
Try this function to test if the file exists (not sure how to make this work on Mac...) :
Public Function File_Exist(sFilePath As String) As Boolean
Dim sProv As String
On Error GoTo ErrorHandler
sProv = Dir(sFilePath, vbDirectory)
File_Exist = (sProv <> "")
On Error GoTo 0
Exit Function
ErrorHandler:
MsgBox Prompt:="Error on test file= " & sFilePath & vbCrLf & Err.Number & vbCrLf & Err.Description
End Function
And your code with some improvements :
ans = MsgBox(Prompt:="Document 1", Buttons:=vbYesNo, Title:="Print")
If ans = vbYes Then
Dim objWord As Object
Dim objDoc As Object
Dim sFilePath As String
''If the file is a network, you should start the path with //
sFilePath = "New_path_from_Word_immediate_window"
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set objWord = CreateObject("Word.Application")
End If
On Error GoTo 0
objWord.Visible = False
'Enter filename and path here
'If File_Exist(sFilePath) Then
Set objDoc = objWord.Documents.Open(sFilePath)
objDoc.PrintOut
objDoc.Close
'Else
'MsgBox "File doesn't exist!" & vbCrLf & sFilePath, vbCritical + vbOKOnly
'End If
objWord.Quit
End If
I am trying to populate word content controls using input from a spreadsheet. My code either doesn't work OR consistently work one time out of 2. I get the error 462.
Can someone help me to figure out what the problem is?
Thanks!
Private Sub Accept_Click()
Dim directory As String
Dim wrdApp As Word.Application
Dim doc As Word.Document
Dim fd As Office.FileDialog
Dim dt As String
Set wrdApp = CreateObject("Word.Application")
directory = Application.ActiveWorkbook.Path
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = directory
.AllowMultiSelect = False
.Title = "Select doc letter"
.Filters.Add "All", "*.*"
If .Show = True Then
txtfilename = .SelectedItems(1)
End If
End With
wrdApp.Visible = True
On Error GoTo Handler
'i get error on the next line:
Set doc = wrdApp.Documents.Open(txtfilename, , False, , , , , , , , , True)
Documents(txtfilename).Activate
For Each cc In ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ContentControls
If cc.Tag = "uptitle" Then cc.Range.Text = mill_box.Text
Next
For Each cc In ActiveDocument.StoryRanges(wdMainTextStory).ContentControls
If cc.Tag = "client" Then cc.Range.Text = TextBox1.Text & Chr(10) & TextBox2.Text _
& ", " & TextBox3 & Chr(10) & TextBox4 & " , " & TextBox5 & Chr(10) & TextBox6
If cc.Tag = "mill" Then cc.Range.Text = mill_box.Text
Next
ActiveDocument.Windows.Application.WindowState = wdWindowStateMaximize
Unload Me
ActiveDocument.Activate
Exit Sub
Handler:
Set wrdApp = Nothing
Set doc = Nothing
Unload Me
MsgBox "error"
End Sub
Interesting error!
Reading the info from this page (which was Google hit #2 for me on "error 462" - LMGTFY :) ) points to an answer discussed in a Microsoft knowledge base article:
You create a Word Application object through code, and assign it to a variable.
When you reference any of Word's Application members (like ActiveDocument) without the qualifying Application variable in front of it, VBA creates a hidden variable for it instead.
All seems fine, since VBA can call Word through both your own variable and the hidden one.
When you now set your own variables to Nothing, the hidden variable will still be there keeping Word alive.
When you come around a second time, the implicit hidden variable messes things up.
Your code also accesses ActiveDocument and Documents(txtfilename) instead of your own doc and wrdApp.
I do not know if this is a solution to your problem (no time to check it through), but it seems very applicable.
When it goes through without an error you are unloading Me and then exiting the sub. You don't set wrdApp and doc to Nothing like you do when there is an error. If you fix that logic so those get set to nothing on a successful run does it keep happening?
After a few days of trial and errors, here is the code that finally get things done. Thank you for everyone for taking your time to help me in this matter.
Private Sub Accept_Click()
Dim directory As String
Dim wrdApp As Word.Application
Dim doc As Word.Document
Dim fd As Office.FileDialog
On Error Resume Next
'this part is not necessary, but end users will know they can't have other word
'docs open when working with this file.
Set wrdApp = GetObject(, "Word.Application")
Set doc = wrdApp.Documents("Welcome letter.docx")
If Error <> 0 Then
Call Killword
End If
On Error GoTo Error_Handler
Set wrdApp = CreateObject("Word.Application")
directory = Application.ActiveWorkbook.Path
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = directory
.AllowMultiSelect = False
.Title = "Select welcome letter"
.Filters.Add "All", "*.*"
If .Show = True Then
txtfilename = .SelectedItems(1)
End If
End With
'here is the thing: i had to instantiate the doc before making wrdapp visible.
Set doc = wrdApp.Documents.Open(txtfilename, , False, , , , , , , , , True)
wrdApp.Visible = True
doc.Activate
'from now on I have no choice than to refer to doc (not documents(1) or activedocuments! neither work)
For Each cc In doc.StoryRanges(wdPrimaryHeaderStory).ContentControls
If cc.Tag = "uptitle" Then cc.Range.Text = mill_box.Text
Next
For Each cc In doc.StoryRanges(wdMainTextStory).ContentControls
'here goes the code i need to execute on my word document. can be anything.
Next
doc.Windows.Application.WindowState = wdWindowStateMaximize
Unload Me
Exit Sub
Error_Handler:
Select Case Err.Number
Case 429, 91
Err = 0
Resume Next
Case Else
MsgBox ("An unexpected error has occured." & vbCrLf & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & "Error description: " & Err.Description)
Resume Next
End Select
'Set wrdApp = Nothing
'Set doc = Nothing
Unload Me
End Sub