I'm trying to create an Excel macro that exports worksheets to PDF. I have a simple piece of code below that successfully exports the active sheet to the folder that I want. What I want to do - and can't find a solution for - is a way to give the user the option to export multiple worksheets to the same PDF. In my application the worksheets exported may have different names, may be created after the macro is written and may be a different number of sheets each time. I have tried to make arrays that use selection but this is beyond my own knowledge of macro writing, which is limited. In an ideal world, I'd like to use a pop-up selection box to choose the sheets to export, but I'll start with the basics of the code first.
Could someone please suggest a section of code that would suit my application?
Sub Export_PDF()
'File name
Dim saveName As String
saveName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
'File path
Dim saveLocation As String
saveLocation = "C:\Users\" & Environ("username") & "\Temp Out\"
'Save Active Sheet(s) as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation & saveName
End Sub
Excel stores worksheets as a collection, so you can easily access all the worksheets that have been created in the workbook.
To allow user to select which ones he wants to export, you can create a UserForm with a ListBox that will read all available worksheets in the workbook and display them. Sample code that does that below (the UserForm has only one listbox created ListBox1 and nothing else).
Sub export_wsheets()
Dim wsheet As Worksheet
Dim wsheets_col As worksheets
Dim uForm As New UserForm1
Set wsheets_col = ThisWorkbook.worksheets
For Each wsheet In wsheets_col
uForm.ListBox1.AddItem wsheet.Name
Next
uForm.Show
End Sub
From then on you can just save user's choice and loop through the workbooks again exporting the ones that were selected. You can access particular worksheet by using it's name or ID.
It's not a complete solution but I hope it sheds some more light on your problem.
I have a huge Excel spreadsheet that I need to allow access to a large set of users so they can manipulate it for their customers, but I don't want them to be able to overwrite the original file (a variable easily set in Excel) or save their file outside the current folder - so I want to force them in a "saveas" mode, and force the file to be saved in that folder. Otherwise, they won't be able to save. I'm not much of a VBA person, and I've found a lot of examples that may work, but nothing seems to be exactly what I need or maybe I'm not smart enough to figure it out. I found this code, but I'm not sure it FORCES the issue. Help?
I've tried to manage this in GPOs but everything seems to give them access to download the folder and save in other places.
Sub ExampleToSaveWorkbookSet()
Dim wkb As Workbook
'Adding New Workbook
Set wkb = Workbooks.Add
'Saving the Workbook
wkb.SaveAs "C:\WorkbookName.xls"
'OR
'wkb.SaveAs Filename:="C:\WorkbookName1.xls"
End Sub
Expected output is the amended Excel file saved in the original directory with a different name, or not at all.
Here's a macro that runs on open and immediately saves as .xlsx to a user location you can specify. Unfortunately the original needs to be .xlsm to store a macro.
This macro is to be located in the "ThisWorkbook" object. It will exit before making a copy when you open the workbook.
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = ActiveWorkbook
vWbName = wb.Name
vUserProf = Environ("USERPROFILE")
vx = InStr(1, vUserProf, "Users\")
If "<Use your own profileID>" = Mid(vUserProf, vx + 6) Then Exit Sub
vDir = vUserProf & "\Downloads\"
vWbName = Left(vWbName, Len(vWbName) - 5) & ".xlsx"
wb.SaveAs vDir & vWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox "You are now using a copy of the original"
End Sub
I would like to have a button on this excel sheet whose name should be “Save as PDF”.
When I press this button it should save the excel sheet’s all data into PDF at the path- M:\formats\ ‘File Name’
‘File Name’ should be the value of cell No H8.
In another words when I click “Save as PDF” button it should save the excel file in pdf form, into the above mentioned path and also with the name whichever is written in cell no H8.
For example, if the name ANDREW PITTERSON is written in H8 cell then it should save with the same name I.e. ANDREW PITTERSON.
Kindly look at this snapshot.
http://i.imgur.com/JJdlFSi.jpg
THANKS
Here's a link to a great simple article, to do this sort of thing. http://www.contextures.com/excelvbapdf.html
I've tested the code example in Excel 2013 and it works fine. The code asks the user what directory to save the PDF in.
But your question says that you also want to save to a specific location (without user intervention) and to get the filename from a cell.
Update - And you'd also like to save the file as an XLSM, once the PDF is created.
The code below does what you're after (all credit to the original author, but my own OCD led me change var names to a format that I like).
I'm guessing the OP would like to know HOW it was done, rather than just have the answer, so I've tried to make the example easy to follow, rather than trying to observe best practice - I'd appreciate not being down-voted for this.
Please note, you must first open the Excel Code window, got to Tools, then References and select 'Microsoft Scripting Runtime' then click Ok. This lets you use many useful functions.
I keep the directory path (hard coded) and the filename separate, so that I can get the 'BaseName' in a clearer way. Obviously this could be done in less lines, but at the risk of making it harder to follow.
Sub ExportAPDF_and_SaveAsXLSM()
Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject
Dim strFileName As String
Dim strBasePath As String
strBasePath = "M:\formats\"
strFileName = Range("H8")
On Error GoTo errHandler
Set wsThisWorkSheet = ActiveSheet
wsThisWorkSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strBasePath & strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
' Now we need to get rid of the .PDF extension. Many ways to code round this, but here is a built in function.
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsm"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Workbook now saved in XLSM format."
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Just add the button (ActiveX Button) to your worksheet and call this sub from the buttons code window (or just paste the code directly into the Button code window).
Hope that helps.
ADDED:
To save the file as an XLSX (No Macros), then replace the code toward the end of the SUB with:
Application.DisplayAlerts = False
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = False
I need to call and execute VBA in an Excel spreadsheet from an Access form+button using VBA.
I have several Excel spreadsheets that are connected to my Access DB. I created a separate DB with VBA (C:\CDR & Project Inventory Reports\RebuildDB) to refresh and rebuild my source databases and report workbooks. I also created a separate workbook to refresh all of my other reports (C:\CDR & Project Inventory Reports\RefreshReports). Module 15 of that .xlsm will call all of my other modules to refresh those reports.
Prior to executing the Excel portion of the code is all of my code pertaining to rebuilding the DB. Currently, the Excel portion looks like this:
Dim oXLApp As Object
Set oXLApp = CreateObject("Excel.Application")
oXLApp.Visible = True
oXLApp.Workbooks.Open ("C:\CDR & Project Inventory Reports\RefreshReports.xlsm")
Debug.Print "Open report refresh code"
Debug.Print "refreshing all spreadsheets"
oXLApp.Run "RefreshReports.Module15" 'refreshes all CDR and Proj Inv spreadsheets
DoEvents
Debug.Print "Refresh completed"
oXLApp.ActiveWorkbook.Close (True)
oXLApp.Quit
Set oXLApp = Nothing
Debug.Print "Release object"
The problem I'm having is that oXLApp.Run doesn't actually execute the VBA it needs to. It calls it, then immediately closes. Is there any other way to call it that would result in the code actually running?
oXLApp.Run "RefreshReports.Module15"
should be
oXLApp.Run "RefreshReports.xlsm!NameOfMySub" '// Change sub name as required
As it stands, your code isn't running any VBA from Excel because you haven't referred to a specific sub. I presume you have error handling switched off as this should be rather noticeable.
You should fully qualify the sub to be executed, by also giving the module name
so
oXLApp.Run "RefreshReports.Module15"
should be
oXLApp.Run "'RefreshReports.xlsm'!Module15.NameOfMySub"
If you use
oXLApp.Run "'RefreshReports.xlsm'!NameOfMySub"
and
the procedure NameOfMySub is declared in more than one module
you will get and error message.
You could also re-write your code thus:
Dim oXLApp As Object
Dim Wkbk as workbook
Set oXLApp = CreateObject("Excel.Application")
oXLApp.Visible = True
set Wkbk = oXLApp.Workbooks.Open ("C:\CDR & Project Inventory Reports\RefreshReports.xlsm")
Debug.Print "Open report refresh code"
Debug.Print "refreshing all spreadsheets"
oXLApp.Run "'" & Wkbk.Name & "'!Module15.NameOfMySub"
' Note use of single speechmarks arond workbook name
I'm trying to save a macro-enabled Excel workbook as a csv file, overwriting the old one (below I had to change the name of the folder and the Sheet, but that doesn't seem to be the issue).
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Sheets("My_Sheet").Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Activate
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
Sometimes it fails with
Runtime Error 1004: method saveas of object _workbook failed**)
The debugger points out:
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
I googled and some of the solutions I tried were:
Specifiying that the directory is a string
Avoid any special character in the file name or folder (seen here)
Copy paste the worksheet as value before saving it as .csv (seen here)
Specifying the FileFormat with the .csv code number (seen here)
Disabling/Re-enabling some of the alerts
Adding other fields in the ActiveWorkbook.SaveAs row, regarding passwords, creating backups etcetc
Still, it might run correctly up to 50-60 times in a row, and then at some point fail again.
Any suggestion, except stop using VBA/Excel for this task, which will happen soon, but I can't for now.
EDIT: Solved thanks to Degustaf suggestion. I made only two changes to Degustaf's suggested code:
ThisWorkbook.Sheets instead of CurrentWorkbook.Sheets
FileFormat:=6 instead of FileFormat:=xlCSV (apparently is more robust
to different versions of Excel)
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim TempWB As Workbook
Set TempWB = Workbooks.Add
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
ThisWorkbook.Sheets("My_Sheet").Copy Before:=TempWB.Sheets(1)
ThisWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=6
TempWB.Close SaveChanges:=False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
I generally find that ActiveWorkbook is the problem in these cases. By that I mean that somehow you don't have that workbook (or any other) selected, and Excel doesn't know what to do. Unfortunately, since copy doesn't return anything (the copied worksheet would be nice), this is a standard way of approaching this problem.
So, we can approach this as how can we copy this sheet to a new workbook, and get a reference to that workbook. What we can do is create the new workbook, and then copy the sheet:
Dim wkbk as Workbook
Set Wkbk = Workbooks.Add
CurrentWorkbook.Sheets("My_Sheet").Copy Before:=Wkbk.Sheets(1)
Wkbk.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
Wkbk.Close SaveChanges:=False
Or, there is an even better approach in a situation like this: WorkSheet supports the SaveAs method. No copy necessary.
CurrentWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
I will warn you to resave the workbook to its original name afterwards, if it is staying open, but you already have that in your code.
This is a year old, but I'll add something for future readers
You won’t find a lot of documentation in Excel help for Run-time error 1004 as Microsoft doesn't consider it to be an Excel error.
The answers above are 100% valid but sometimes it helps to know what is causing the problem so you can avoid it, fix it earlier or fix it more easily.
The fact that this is an intermittent fault, and it is fixed by saving with the full path and file name tells me that either your macro may be trying to save an .xlsb file to the autorecover directory after an auto file recovery.
Alternatively, you may have edited the file's path or filename yourself.
You can check the path and filename with:-
MsgBox ThisWorkbook.FullName
You should see something like this in the message box.
C:\Users\Mike\AppData\Roaming\Microsoft\Excel\DIARY(version 1).xlxb
If so the solution is (as stated above by others) to save your file to its correct path and file name. This can be done with VBA or manually.
I am now in the habit of manually saving the file with its correct path and filename as a matter of course after any autorecover action as it takes seconds and I find it quicker (if this is not a daily occurrence). Thus, the macros will not encounter this fault you run it. Remember that while my habit of manually saving .xlxb files to .xlsm files immediately after a recovery won't help a novice that you give the worksheet to.
A note on Hyperlinks
After this error: If you have hyperlinks in your worksheet created with Ctrl+k in all likelihood, you will have something like "AppData\Roaming\Microsoft\", "\AppData\Roaming\", "../../AppData/Roaming/"or "....\My documents\My documents\" in multiple hyperlinks after file recovery. You can avoid these by attaching your hyperlinks to a text box or generating them with the HYPERLINK function.
Identifying and Repairing them is a little more complicated
First, examine the hyperlinks and determine the erroneous strings and the correct string for each error. Over time, I have found several.
Excel doesn't provide a facility in the 'Go To Special' menu to search for hyperlinks created with Ctrl+k.
You can automate the identification of erroneous hyperlinks in a helper column, say column Z and using the formula
=OR(ISNUMBER(SEARCH("Roaming", Link2Text($C2),1)),ISNUMBER(SEARCH("Roaming", Link2Text($D2),1)))
where Link2Text is the UDF
Function Link2Text(rng As Range) As String
' DO NOT deactivate.
' Locates hyperlinks containing 'roaming' in column Z.
' Identify affected hyperlinks
If rng(1).Hyperlinks.Count Then
Link2Text = rng.Hyperlinks(1).Address
End If
End Function
My VBA to correct the errors is as follows
Sub Replace_roaming()
' Select the correct sheet
Sheets("DIARY").Select
Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\Microsoft\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "../../AppData/Roaming/", "..\..\My documents\")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "..\..\My documents\My documents\", "..\..\My documents\")
Next
Application.Run "Recalc_BT"
' Move down one active row to get off the heading
ActiveCell.Offset(1, 0).Select
' Check active row location
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Select
End If
' Recalc active row
ActiveCell.EntireRow.Calculate
' Notify
MsgBox "Replace roaming is now complete."
End Sub
I also recommend you get in the habit of doing regular backups and not relying on autorecover alone. If it fails, you have nothing since your last full backup.
While the worksheet is being fragile backup often, like every hour or after any significant import of new data.
The following shortcuts will backup your worksheet in seconds: Ctrl+O, [highlight the filename], Ctrl+C, Ctrl+V, [ X ]. Regular backups allow you to go immediately to your most recent backup without having to restore from last night's backup file especially if you have to make a request of another person to do this.
It's been a while since the last answer here, but I want to share my experience from today:
After weeks of reliable operation, I ran into the same error all of a sudden without having anything changed in the code section where the workbook is saved.
Thanks to the previous answers I updated my saveas statement from a simple
wb.saveas strfilename
to
wb.saveas Filename:=strfilename, Fileformat:= xlWorkbookDefault
et voilà: it worked again.
Sometimes the Microsoft applications behave really strange...
Try combining the Path and the CSV file name into a string variable and drop the .csv; that is handled by the FileFormat. Path must be absolute starting with a drive letter or Server Name:
Dim strFullFileName as String
strFullFileName = "C:\My Folder\My_Sheet"
If on a Server then it would look something like this:
strFullFileName = "\\ServerName\ShareName\My Folder\My_Sheet"
Substiture ServerName with your Server name and substitute ShareName with the your network Share name e.g. \\data101\Accounting\My Folder\My_Sheet
ActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False
I had a similar issue however for me the problem was I was creating the Filename based on strings extracted from a workbook and sometimes these strings would have characters that can't be in a filename.
Removing these characters did the trick for me!
For me there was an issue with not all formulas being calculated, despite having it on "Automatic". I pressed calculate on the bottom left 100 times and then it magically worked.