VBA Saving (and converting) a Document From .docm to .docx - vba

I have the following code at the end of a project:
'Save the Document
Dim Directory As String, FileName As String
Directory = "C:\Users\" & (Environ$("Username")) & _
"\Desktop\STL\"
If Len(Dir(Directory, vbDirectory)) = 0 Then
MkDir Directory
End If
FileName = sDNUM & " " & Format(Date, "YYYY-MM-DD") & ".docx"
SaveAs Directory & FileName
MsgBox "File saved to:" & vbNL & Directory & FileName
and I am trying to get the file to save as a docx (non-macro enabled) after running a macro-enabled workbook.
The problem is by using the above method to save my file, upon attempting to open the newly saved file I receive the following error message:
The file < filename > cannot be opened because there are problems with the contents.
What method should I use to properly save these documents?
Miscellaneous notes for the curious:
vbNL is just a function for vbNewLine. I use it quite often and I guess I am just too lazy to type it out all the time so I made a function to shorten the text.
sDNUM is also just another function that is irrelevant to the issue.

Saving the file with a docx extension does not automatically convert it as non-macro-enabled.
Change
SaveAs Directory & FileName
to
SaveAs2 Directory & FileName, wdFormatXMLDocument
For more information on the SaveAs2 method, see here.

Related

VBA Outlook Rule call subroutine to save to disk

I completely lost my VBA touch, anyone that can help, I greatly appreciate it.
For outlook desktop I want to a rule that automatically moves item to a folder, marks it as read and calls a script. ( I managed to do that )
How to enable script in outlook 2016: https://www.slipstick.com/outlook/rules/outlooks-rules-and-alerts-run-a-script/
For the subroutine to be seen by Rule Wizard, the argument must by type MailItem.
The script I want to run, is to save the message identified by the rule to disk as a txt file, and for that I am using:
In the module "ThisOutlookSession" the following code ( found it on Outlook VBA macro for saving emails copies in a local folder ) :
Public Sub SaveToDiskScript(Item As Outlook.MailItem)
Const olMsg As Long = 0 '0=Text format (.txt) -> https://learn.microsoft.com/en-us/office/vba/api/outlook.olsaveastype
Dim m As MailItem
Dim savePath As String
Set m = Item
savePath = "C:\Users\im.a.pretty.user\Desktop\StorageFolder\"
savePath = savePath & m.Subject & Format(Now(), "yyyy-mm-dd-hhNNss")
savePath = savePath & ".txt"
m.SaveAs savePath, olMsg
End Sub
Thank you
The file path passed to the SaveAs method of the MailItem class is built based on the Subject line which may contain forbidden symbols:
savePath = "C:\Users\im.a.pretty.user\Desktop\StorageFolder\"
savePath = savePath & m.Subject & Format(Now(), "yyyy-mm-dd-hhNNss")
savePath = savePath & ".txt"
I'd recommend checking whether it contains any forbidden symbols before, see What characters are forbidden in Windows and Linux directory names? for more information.
Also you may try to specify a different folder without dots in the file path.

How to save automatically in 2 different format without dialog

I have a huge documents (.doc) in c:\sample folder. I want to save them in .docx, .pdf, .txt to c:\sample_converted folder after changing the font.
I have VBA script to change the font and it works fine..However got stuck in saving them in different format as well as without save dialog
I want to do this conversion entirely without user intervention. If not possible, at-least user can be requested for the source and target folder once.
strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".txt"
oDoc.Range.Font.Name = strFont
oDoc.Save
oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText
strName = Left(oDoc.FullName, InStrRev(oDoc.FullName, ".") - 1) & ".docx"
oDoc.Save
oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatXMLDocument
oDoc.Close SaveChanges:=wdDoNotSaveChanges
WordBasic.DisableAutoMacros 0
Please advise how to do this.
Thanks.
SaveAs2 does not work with Word 2007. For 2007 and previous change the line
oDoc.SaveAs2 FileName:=strName, FileFormat:=wdFormatUnicodeText, Encoding:=65001
to
oDoc.SaveAs FileName:=strName, FileFormat:=wdFormatUnicodeText, Encoding:=65001
<=2007 is SaveAs and >2007 is SaveAs2
Now it works well.

VBA unable to move on to next file in Directory, instead picking file named ".."

I am having a little issue with the Loop function to open files within a Directory. Find the code below:
'Build the complete folder path:
strTargetFolder_Batch = "I:\PerfTeam"
strTargetFolder_Batch = strTargetFolder_Batch & strMonthNo & " " & strMonthName & " " & strYear & "\" & "Attribution - Draft"
If Right(strTargetFolder_Batch, 1) <> "\" Then
strTargetFolder_Batch = strTargetFolder_Batch & "\"
End If
If Not CreateFolder(strTargetFolder_Batch) Then
MsgBox "Unable to create the folder:" & vbCrLf & strTargetFolder_Batch, vbExclamation
Else
End If
FolderPath = strTargetFolder_Batch
'Sets Parameters to Open the file
MyFolder = FolderPath 'location of files
MyExtension = "*.xlsx*"
MyFile = Dir(MyFolder & MyExtension)
Do While MyFile <> "" 'will start LOOP until all files in MyFolder have been looped through
Set oWbk = Workbooks.Open(MyFolder & "\" & MyFile)
*Batch Run is a Boolean function*
'*** 1. Calls Import Data Macro, which Imports the Data ***'
Call Import_new_data(Batch_Run, oWbk)
'*** 2. Calls Data Collector Macro, which Analyses the Data ***'
Call Data_Collector(Batch_Run)
'*** 3. Calls Report Production Macro, which Produces Report ***'
Call Report_Production_Sub(Batch_Run)
ContinueLoop:
MyFile = Dir
'**^^ Here is where the Macro breaks after completing a full first iteration** !
Loop
What essentially the macro does, it picks up data from the opened file, closes the file and then analyses it, before creating a report out of it. It should then move on the second file in the folder and perform the same operation.
While the first file gets opened fine, and analysed as it should, the problem arises moving on to the second file. The variable MyFile in fact picks up a 'Ghost' file named ".." which then throws an error of course as it does not exist. Doing some research I have found out this may relate to the Directory path.
Any help would be super appreciated!
Calling the Dir function with parameter starts a search for matching files. If nothing is specified as second parameter, is will search only regular files (no directories, no hidden files etc).
Any following calls to Dir (without parameter) will continue the last search initiated by a Dir(with parameter).
The .. you get as result of the Dir within your loop is not a file, it's a folder (up directory). You will get this only when you started a Dir with option vbDirectory as second parameter. As this parameter is missing in your code, I would strongly assume that anywhere in your code (that is not displayed) a new Dir-search is started (which destroys the search results of a previous Dir-search).
Update: If you need to check if a folder exists but don't want to destroy your Dir-Loop, you could use the FileSystemObject. The FileSystemObject is usefull for several things concerning files and folders.
if CreateObject("Scripting.FileSystemObject").FolderExists("<enter your path>") then

Print File - Macro

I have created a macro that I can use to print PDF files. The PDF files will be saved in a folder to print. The path will be given that folder path where I save all PDF files. My questions are:
1) Once the files are saved in folder, is it possible to sort it automatically like first come first print. Now the issue is - prints did not come out in order of how the files are – we have to reconcile all files, so looking for each one in a random list order would take lots of time.
2) Is it possible to have the files automatically deleted from the folder after the printing is completed?
Public Sub Print_All_PDF_Files_in_Folder()
Dim folder As String
Dim PDFfilename As String
folder = "\\maple.fg.rbc.com\data\toronto\user_3\315606053\myWorkspace\Desktop\test" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "\" Then folder = folder & "\"
PDFfilename = Dir(folder & "*.pdf", vbNormal)
While Len(PDFfilename) <> 0
If Not PDFfilename Like "*ecg*" Then
Print_PDF folder & PDFfilename
End If
PDFfilename = Dir() ' Get next matching file
Wend
End Sub
Sub Print_PDF(sPDFfile As String)
Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
' This is path of Adobe in the desktop
End Sub
There is no build in way to sort files. However, it is rather easy to read the filenames and -dates into arrays and sort them manually, but you have to use the FilesystemObject rather than using dir to get the file dates.
You can find an example to do so for example here: https://social.msdn.microsoft.com/Forums/office/en-US/5f27936e-1d98-44df-8f69-0f81624c4b92/read-files-in-a-folder-in-descending-order-with-file-name-or-date-created?forum=accessdev
The command to delete a file with VBA is kill, or you can use the .DeleteFile method of FilesystemObject. However, this will work only if the printing is already done, so you have to wait for your shell-command to finish. For this, you have to use the wscript.shell, see for example here https://stackoverflow.com/a/8906912/7599798

How to open a file and make it default in VBA

I am trying to make "python.py" to open in notepad each time...I have got the code that does that but how to make it as default..so next time if the user wants to open the python file in notepad, it should open in notepad all the time using VBA and only after the code is excecuted...please find the code below for opening a python file in notepad..
Shell "notepad C:\Users\stackoverflow\Desktop\python.py", vbNormalFocus
You could try a VBA macro attached to a button that does this. But I am unsure if this is what you are asking for.
Sub LetterChecklist()
Dim strPath As String
Dim strProgram As String
strPath = "\\aw\data\Letters\2099_Correspondence\Incoming Letters\.pdf"
strProgram = "C:\Program Files (x86)\Adobe\Acrobat 11.0\Acrobat\Acrobat.exe"
Call Shell("""" & strProgram & """ """ & strPath & """", vbNormalFocus)
End Sub