Word VBA macro to insert file and merge formatting - vba

I have a template with a header/footer and text formatting. I would like to write a macro to fill this template with the contents of an .rtf or .doc file. Also, I would like to merge the formatting so that I keep the header and formatting from the template file, and the pictures in the .rtf or .doc files.
Cut-and-paste works great. If I open and save the template file, open the file to insert, select all, and paste special with "merge formatting", then I get exactly what I want. I just want a more scalable solution.
I wrote a macro that does most of this, but it fails to merge the formatting and drops (or hides) the header and footer. I thought the correct approach would use the InsertFile method, but I can't figure it out.
Any pointers would be appreciated (I'm new to both Word and VBA).
Sub InsertFile()
currentPath = ActiveDocument.Path
Set FileBox = Application.FileDialog(msoFileDialogFilePicker)
With FileBox
.Title = "Select the File that you want to insert"
.InitialFileName = currentPath & "\" & "*.rtf"
.AllowMultiSelect = False
If .Show = -1 Then
FiletoInsert = .SelectedItems(1)
End If
End With
Selection.Range.InsertFile FiletoInsert
Set FileBox = Nothing
End Sub
Update - I also tried this approach, which seems to use cut-and-paste, but the results are the same.

Here's the best that I can do. It pastes as plain text, but that's better than nothing (or pasting with original formatting).
Sub InsertFile()
' inserts selected file into current document (strips formatting)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select the File that you want to insert"
.Show
FiletoInsert = .SelectedItems(1)
End With
' get content from my file
Application.Documents.Open (FiletoInsert)
Application.Selection.WholeStory
Application.Selection.Copy
Application.ActiveWindow.Close
' paste without formatting
Application.Selection.PasteSpecial DataType:=wdPasteText
End Sub

Sub InsertFile()
' inserts selected file into current document (strips formatting)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select the File that you want to insert"
.Show
FiletoInsert = .SelectedItems(1)
End With
Selection.InsertFile FileName:=FiletoInsert, Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
End Sub

I've tried this same call in my own VBA macro, and find that
Selection.Range.InsertFile (FiletoInsert)
Seems to work when I only pass the one parameter filename. Make sure the filename is complete.

Related

VBA FileDialog saves powerpoint as .ppt instead of .pptx

I have a PowerPoint with a couple macros: one that allows you to load some data from a Word, and another one that exports the PowerPoint to the same location where the Word was. This is the latter:
Sub export()
Dim dlgSaveAs As FileDialog
Dim strMyFile As String
Dim ppPres As Presentation
Set dlgSaveAs = Application.FileDialog(Type:=msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = path & "Exported without macros - " & company & " (((insert date)))"
If .Show = -1 Then
strMyFile = .SelectedItems(1)
'MsgBox strMyFile
ActivePresentation.SaveAs strMyFile, 1
'-- save your file to strMyFile here
Else
'MsgBox "No file selected."
'-- The user pressed Cancel.
End If
End With
Set dlgSaveAs = Nothing
End Sub
To be honest, I didnĀ“t wrote this code. I found it months ago and adapted it and I dont know how it really works.
The issue is that when the 'Save As' FileDialog opens, the file extension seems to be ok:
But after pressing 'save' the file gets saved as a .ppt:
Any idea how to fix this?
Change this:
ActivePresentation.SaveAs strMyFile, 1
to this:
ActivePresentation.SaveAs strMyFile, 24
or to
ActivePresentation.SaveAs strMyFile, ppSaveAsOpenXMLPresentation

VBA pick a file from a specific location?

I'm attempting to put together some code in VBA where it will open a specific folder, let me choose the file then continue running my code.
Currently what I have (below) "works" in that it will open a folder but usually it starts from a generic location (Desktop) but will not go the the specific folder location to let me open the file I want.
Dim Filename as String
filename = Application.GetOpenFilename(FileFilter:="Excel Files, *.xl*;*.xm*")
If filename <> False Then
Workbooks.Open filename:=filename
End If
I've also tried something like this:
Dim Directory as String
Dim Filename as String
Directory = "\\page\data\NFInventory\groups\CID\Retail Setting\Lago Retail Uploads\" & strBrand & "\" & strSeason & "\" & strPrefix & "\"
Filename = Dir(Directory & "*.xl*;*.xm*")
Workbooks.Open Filename:=Directory
But it doesn't do anything and I think I have everything right. Any help or push in the right direction would be greatly appreciated.
-Deke
This will start an Open Dialog at the specified location:
Sub openBeckJFolder()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
.InitialFileName = "C:\Users\beckj\"
End With
End Sub
The Microsoft document page doesn't really get into it, but FileDialog has several features such as the InitialFileName that I used here.
_
UPDATE: To open the workbook
Code added that allows you to highlight the workbook & click Open, or double-click on the workbook to open it.
Sub openBeckJFolder()
Dim Filename As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "C:\Users\beckj\"
If .Show = True Then
Filename = .SelectedItems(1)
End If
End With
Workbooks.Open (Filename)
End Sub

How to Save as PDF automatically when doing the Mail Merge (VBA)

When I am trying to run the code below the following happens:
1) It opens a "Save PDF File As" Window
2) I have to manually type in the name
3) The code runs
I want to automate steps 1 and 2 so that the code runs without any manual inputs from me and saves it as whatever.pdf in whatever path.
I tried using ExportAsFixedFormat but the problem is that it is saving only the first page as pdf and the remaining 100+ records that are going through the mail merge are not being saved. On top of that, it still opens that Dialog Window from step 1.
ActiveDocument.ExportAsFixedFormat OutputFilename:=whatever.pdf, _
ExportFormat:=wdExportFormatPDF, etc.
The code:
Sub DoMailMerge()
Set myMerge = ActiveDocument.MailMerge
If myMerge.State = wdMainAndSourceAndHeader Or _
myMerge.State = wdMainAndDataSource Then
With myMerge.DataSource
.FirstRecord = 1
.LastRecord = 3
End With
End If
With myMerge
.Destination = wdSendToPrinter
.Execute
End With
End Sub
Any help on this would be greatly appreciated!
[Edit] Corrected object reference. Added SaveAs2
In the OP, an attempt is made to use a pseudo printer to save as a pdf. There are differences between the SaveAs pdf format and the variety of pdf pseudo printers. Is there a reason for printing to a PDF and saving that file, rather than doing a Save As and choosing the PDF format?
With myMerge
.Destination = wdSendToNewDocument
.Execute
End With
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
The following is sometimes needed to silence prompting with scripted saves. For the above tested method, there were no prompts, so it may not be needed.
Toggle off .DisplayAlerts before SaveAs
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
Application.DisplayAlerts = wdAlertsAll
Or
Dim tempDisplayAlerts As Long
tempDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
Application.DisplayAlerts = tempDisplayAlerts

VBA Excel FileDialog to set/reset filters

I have a macro that asks a user to choose multiple files for data analysis. User selects a Excel or CSV file first (XLSX, XLS, CSV), then asks for a second file but CSV only. The intent of the tool is to combine the two data files into one.
In one Sub, I ask the user to select any compatible XLSX, XLS, or CSV files using the FileDialog code:
Dim myObj As Object
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select Excel file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
End With
It seems to filter appropriately:
After this data analysis in complete, then the user runs a second sub to select another file, but it must be a CSV file only. So I use this code to request CSV:
Dim yourObj3 As Object
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select CSV file.", vbExclamation: Exit Sub
yourDirString3 = .SelectedItems(1)
End With
The problem is the FileDialog box remembers the first filter (Custom XLS) and they need to click the drop down to see the appropriate filter for CSV only...
So this would certainly be confusing to the user...I'm guessing I need to "clear" our that first filter after the user completes the first macro. Any suggestions on that code to clear (or reset) the first filter?
Tried adding this below it when I found what I thought was a similar question FileDialog persists previous filters:
With .Filters
.Clear
End With
But results in Compile error: Invalid or unqualified reference
This works in my environment. The only thing I made differently was to declare dialogs as FileDialog instead of Object.
Sub Test()
Dim myObj As FileDialog
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
.Show
End With
Dim yourObj3 As FileDialog
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
.Show
End With
End Sub
Although it is not directly the answer to the specific msoFileDialogFilePicker from the OP (and googled this answer), I had the same problem with the msoFileDialogSaveAs dialog in Excel 2010 where errors are raised trying to modify the filters in any way because it obviously is not supported :-/
The msoFileDialogSaveAs dialog does NOT support file filters

Excel VBA - Why is my "Save As" not working?

I have a VBA script in place so that if a cell is blank then Excel will prompt the file to be saved.
This is ensure that the template is not altered. However, when the user clicks save in the "Save As" dialogue box, the file does not save.
This is the code I am using:
If Worksheets("Input").Range("E2").Value = "" Then
Application.EnableEvents = False
Application.GetSaveAsFilename InitialFileName:="\\ac35542\Problem Management\Action Plans\ChangeMe.xlsm", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm"
Application.EnableEvents = True
MsgBox "Please ensure fill in the Problem Reference Number, Problem Title, and Select a Contract", vbExclamation, "PR Reference & Title"
Worksheets("Input").Select
Range("E2").Select
End If
Why is the file not saving?
As follow up from MSDN
Application.GetSaveAsFilename displays the standard Save As dialog box
and gets a file name from the user without actually saving any
files..
use this one instead:
Dim fileSaveName
If Worksheets("Input").Range("E2").Value = "" Then
Application.EnableEvents = False
fileSaveName = Application.GetSaveAsFilename(InitialFileName:="\\ac35542\Problem Management\Action Plans\ChangeMe.xlsm", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
Application.EnableEvents = True
If fileSaveName <> "False" Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs (fileSaveName)
Application.DisplayAlerts = True
End If
MsgBox "Please ensure fill in the Problem Reference Number, Problem Title, and Select a Contract", vbExclamation, "PR Reference & Title"
Worksheets("Input").Select
Range("E2").Select
End If
I think Dmitry Pavliv's method is fine, but I think the "InitialFileName:="\ac35542\Problem Management\Action Plans\ChangeMe.xlsm" part makes it a little bit less dynamic.
For me, the below code worked perfectly:
ExportPath = Application.GetSaveAsFilename(FILEFILTER:="Excel Files (*.xlsx), *.xlsx", Title:="")
'Basically, user will specify the path and give it a name and click on Save. It won't get saved until the next line though.
ActiveWorkbook.SaveAs (ExportPath)