Need to call other Word macros in mass update tool - vba

Quick summary: I need to call additional macros to modify documents inside of an existing code that mass converts Word files to PDF (if possible).
Longer story: I have code from a long time ago (credit to wherever I found it a decade ago). It uses a file dialog to allow selecting multiple files, and then converts those selected files to PDF. I have almost 1,800 Word documents that I need to process (using the code #timothyrylatt helped with here: How to find table column, then move down and replace the cell's content IF it is "N/A") and then convert to PDF afterwards. I tried using the 'Call' feature to call the "Demo" macro, and changing the save settings but the files only convert to PDF without calling the other "Demo" macro. I tried calling it in different areas as well, but to no avail.
Note: If it is not possible to add to this existing code, is there still a way to at least select the multiple files, run the Demo macro, then save and close in a similar manner?
Thank you in advance for any assistance!
Sub MassUpdate()
Dim wDoc As Word.Document
Dim FoundFile As Variant
Dim wDialog As FileDialog
Set wDialog = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
wDialog.AllowMultiSelect = True
If wDialog.Show <> -1 Then
Exit Sub
End If
For Each FoundFile In wDialog.SelectedItems
Set wDoc = Documents.Open(FoundFile, ReadOnly:=False, Visible:=False)
Call Demo
wDoc.ExportAsFixedFormat _
OutputFileName:=wDoc.Path & "\" & Left(wDoc.Name, InStrRev(wDoc.Name, ".")) & "pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
wDoc.Close SaveChanges:=True
Next
Dim Answer
Answer = MsgBox("Update more files?", vbYesNo, "Run Macro?")
If Answer = vbYes Then
Call MassUpdate
End If
End Sub

I would suspect that the two routines may be targeting different documents. Try modifying your Demo routine to take a document as an input argument:
Sub Demo(targetDoc as Document)
Application.ScreenUpdating = False
Dim r As Long, c As Long
With targetDoc.Range
You would then modify the Call line to (there is no need to use Call):
Demo wDoc

Related

Automated MailMerge to Select Source File

I created a Word (2022) mailmerge document. Later I changed the .docx to a .docm so I could do some post-mailmerge processing on the generated output. Now I'd like to use VBA to allow selection of the source data file, but I wasn't able to make that work.
Then I found [https://stackoverflow.com/questions/61547489/automated-word-vba-mailmerge], which described exactly what I'm looking to perform in VBA. In my mailmerge document VBA I now have:
Private Sub Document_Open()
' Application.ScreenUpdating = False
Dim StrMMSrc As String
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Data Source Selector"
.AllowMultiSelect = False
.Filters.Add "Documents", "*.xls; *.xlsx; *.xlsm", 1
.InitialFileName = ""
If .Show = -1 Then
StrMMSrc = .SelectedItems(1)
Else
GoTo ErrExit
End If
End With
With ActiveDocument.MailMerge
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM 'Students'"
End With
ErrExit:
Application.ScreenUpdating = True
When I open the merge document I can step through the Document_Open code in VBA. The FileDialog works correctly, showing me the folder C:\Gld\RT\Office Database, and I select file "Database 2022-23.xlsx". Variable StrMMSrc is correctly set to the file I selected, "C:\Gld\RT\Office Database\RT Database 2022-23 Test.xlsx". But then it pops up a window "Select Table" showing no tables. If I drop down Workbook, it shows me 2 old Excel documents and a document named "C:\Gld\RT\Office Database.xls", which doesn't actually exist. Any idea as to why it's confusing the "Office Database" folder with a non-existent "Office Database.xls" document?
Jonsson's comments answer the question accurately.
I don't know what went wrong the other day, but using the syntax
SELECT * FROM [Students$] Order by [Grade] ASC, [Last Name] ASC, [First Name] ASC
worked correctly today.
Thanks so much, Jonsson, for your time and effort in helping me.

Closing document after saving it with wdFormatDocument format

I have a longer code and in the final part there is an ActiveX button for saving and closing the file. Also, for efficiency, I've added an vbYesNo command for creating a new document based on the template in use.
The code:
Sub macrosave ()
Dim doc As Document
Dim strDosar As String
Dim Ret As Variant
Set doc = Application.ActiveDocument
strDosar = Range.Paragraphs(1).Range.Text
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then
Documents.Add Template:=ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
End If
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument = 0
doc.Close
End Sub
If I click yes, a new document is created, the last one is saved and closed afterwards.
If I click no, the active document is saved, but it is not closed afterwards.
I suspect it has something to do with the file format (wdFormatDocument) because this way it eliminates all VBA codes.
The file format is needed because I want to get rid of all content controls after saving the file.
Why doc.Close is not being executed in the second case and what are my options in order to achieve the purpose?
This argument is invalid:
FileFormat:=wdFormatDocument = 0
Perhaps:
Sub macrosave()
Dim doc As Document, strDosar As String, Ret As Variant
Set doc = ActiveDocument
strDosar = Split(doc.Range.Paragraphs(1).Range.Text, vbCr)(0)
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then Documents.Add Template:=doc.AttachedTemplate.FullName
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument
doc.Close False
End Sub
I believe the problem comes from a disagreement between the file extension - doc and the specified file format wdFormatDocument.
Starting with Word 2007 the default file format (wdFormatDocument) refers to the Word Open XML file format, docx. To save as the doc file format requires using wdFormatDocument97. The reason it may have intermittently worked is because the numerical value of this enumeration is 0.
Try
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument97
Or change the extension to docx
doc.SaveAs "\\server\Public\" & strDosar & ".docx", FileFormat:=wdFormatDocument
However docx will not remove the content controls the next time the document is opened. (The doc format will because content controls were introduced at the same time as the new file format, so they aren't supported in the old format.)
If the additional purpose is " it eliminates all VBA codes" then it would make sense to change the attached template before closing the document to Normal.dotm. This removes the link to the attached template and has the added advantage that the document will "find" its template no matter who opens it, later. (When the attached template is not present it can delay opening by a considerable time under some circumstances.)
doc.AttachedTemplate = NormalTemplate
Note that it will also make things simpler to pick up the file path using the FullName poperty of the template:
Documents.Add Template:=ActiveDocument.AttachedTemplate.FullName

Saving MS word (docx) as pdf on Mac OS X with one click using macros

I have a question on how to edit the following macros to save MS word (.docx) file as PDF on macOS Sierra without .docx in the file name. That is, the macros works perfectly BUT it always saves files as, for example, letter.docx.pdf. It is a very easy option to save in pdf with one click only.
And I would appreciate if someone could help to me amend the macros below so that there is no .docx in the file name. I have tried to hide extensions in Finder, but that does not seem to help:
Sub SaveActiveDocAsPDF()
On Error Resume Next
ActiveDocument.SaveAs _
fileName:=ActiveDocument.FullName & ".pdf", _
FileFormat:=wdFormatPDF
End Sub
Thank you very much in advance.
You need to remove the existing file extension before adding the new one. Like this:
Sub SaveActiveDocAsPDF()
On Error Resume Next
Dim saveName As String
saveName = ActiveDocument.FullName
saveName = Left(saveName, Len(saveName) - 5) & ".pdf"
ActiveDocument.SaveAs fileName:=saveName, _
FileFormat:=wdFormatPDF
End Sub

FileDialog in Word 2011 VBA

I'm hoping for a bit of a sanity check. I'm adapting a Word add-in (written in VBA for Word 2010) for Mac, specifically, at this point, Word 2011. I'm aware of many of the differences, but one that I haven't been able to find much documentation on is the apparent lack of FileDialog. The closest I've come to an answer is here: http://www.rondebruin.nl/mac.htm where the author uses Application.GetOpenFilename. That method doesn't seem to exist for Word, though (the focus of that site is Excel).
Does anyone know how to use the file and folder picker dialogs that FileDialog makes available? I'm not familiar with Applescript, really, but I've had to learn a little in order to get around Word 2011's funky file management issues (Dir, FileCopy, etc.). So, if that's the answer, any sense of what the code might look like in Applescript would be greatly appreciated. (I more or less know how to translate that into VBA).
I believe you have to use Apple Script in order to do this a bit better on the Mac. The following code allows the user to select text files which is returned as an array from the function. You would simply be able to modify the Apple Script to return other file types and select directories, I'll leave that to you.
The code that calls the function and displays a message box with all the files:
Sub GetTextFilesOnMac()
Dim vFileName As Variant
'Call the function to return the files
vFileName = Select_File_Or_Files_Mac
'If it's empty then the user cancelled
If IsEmpty(vFileName) Then Exit Sub
'Loop through all the files specified
For ii = LBound(vFileName) To UBound(vFileName)
MsgBox vFileName(ii)
Next ii
End Sub
And the function that does the Apple Script work:
Function Select_File_Or_Files_Mac() As Variant
'Uses AppleScript to select files on a Mac
Dim MyPath As String, MyScript As String, MyFiles As String, MySplit As Variant
'Get the documents folder as a default
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Set up the Apple Script to look for text files
MyScript = "set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & " {""public.TEXT""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
'Run the Apple Script
MyFiles = MacScript(MyScript)
On Error GoTo 0
'If there are multiple files, split it into an array and return the results
If MyFiles <> "" Then
MySplit = Split(MyFiles, ",")
Select_File_Or_Files_Mac = MySplit
End If
End Function
Finally, it can be a bit of a pain specifying different file types, if you want to specify only Word documents, then replace public.TEXT with com.microsoft.word.doc, however this won't allow .docx or .docm files. You need to use org.openxmlformats.wordprocessingml.document and org.openxmlformats.wordprocessingml.document.macroenabled respectively for these. For more info on these see: https://developer.apple.com/library/mac/#documentation/FileManagement/Conceptual/understanding_utis/understand_utis_conc/understand_utis_conc.html

How to open Text File with .OpenText in VBA that starts with first column like "ID" without getting SYLK error

I've come across a nasty little bug in Excel VBA's .OpenText method.. It errors on opening any text or CSV file when the first two letters are upper-case "ID". Here is the article from MS so you know I'm not crazy: http://support.microsoft.com/kb/323626
So, I'm trying to figure out a workaround that does NOT involve copying the entire file just to re-name the first header. I am working with some large text files and this would be an unsatisfactory last resort.
I've tried On Error Resume Next before the .OpenText call but that didn't work.. Has anybody come across this and found a simple solution I'm missing? Is there a way to just crack open the first line and find/replace inside of a text file? Or extra parameters to .OpenText I could use?
I wrote this for you. Just call it passing the filepath prior to attempting to open it. I deliberately wrote this with late binding, so no references are required. it will add an apostrophe to the beginning of the file, if the file starts with "ID".
Sub FixIDProblem(filePath As String)
Dim fso As Object
Dim text As Object
Dim contents as String
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(filePath) Then
'Open the file for reading
Set text = fso.OpenTextFile(filePath, 1)
'Load the text contents to variable
contents = text.ReadAll
'Check for the forbidden text at the beginning
If Left(contents, 2) = "ID" Then
text.Close
'Overwrite textfile with it's contents plus an apostraphe
Set text = fso.OpenTextFile(filePath, 2)
text.Write "'" & contents
End If
text.Close
Else
MsgBox "File does not exist"
End If
Set fso = Nothing
End Sub
Just turn the alerts off:
Application.DisplayAlerts = False
Application.Workbooks.OpenText Filename:="startwithID.tab"
Application.DisplayAlerts = True
I did this instead :
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.OpenText Filename:=myfile, DataType:=xlDelimited, Tab:=False, Semicolon:=True, Local:=True
Workbooks.OpenText Filename:=myfile, DataType:=xlDelimited, Tab:=False, Semicolon:=True, Local:=True
Application.DisplayAlerts = True
The first OpenText fails, but the second one works.
The FixIDProblem is a good idea but fails on big files (~ 40MB)