Run Time Error 5 - when saving to shared drive - excel

My code runs perfectly when I save to my local drive, but when I save to the shared drive I get Runtime Error 5? How is this occurring?
I have unmerged cells and put it as center across selection
Ensured that the whole document is within the print margins
Edit: I have tried saving into the folder directory above where I was saving and it works. I understand that there is a character limit (pathname and title), which might be the problem? Is there a way to solve this?
The error is in the following area:
'Creating Only the PDF based on Company Network - there is an existing folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
This is the whole code:
Option Explicit
Private Function selectfolder()
'Defining the Variables
Dim user_name As String
user_name = Environ("username") 'to pick up the username from work environment
'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)
End With
End Function
Sub SaveActiveSheetAsPDF()
'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub
'Defining the Type of Variables
Dim inputrange As Range 'Range represents a cell or multiple cells in Excel
Dim cell As Range
Dim network, Address, Fldr, Title As String
'If user does not choose a folder
Address = selectfolder
If Address = "" Then
Exit Sub
End If
'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)
For Each cell In inputrange
Range("G2").Value = cell.Value
'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"
'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
End If
Next cell
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"
End Sub

It is difficult to diagnose problems with network drive without more information, but I could suggest a workaround instead.
You could save the file on your local drive and then move it using the File System Object in VBA. Here's how it would look like:
'Save Active Sheet as PDF in temporary folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Environ("TEMP") & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Move PDF to Company network drive
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.MoveFile Environ("TEMP") & "\" & Title & ".pdf", Fldr & "\" & Title & ".pdf"
Note that for this code to work, you need a reference to the Microsoft Scripting Runtime Library.

Related

Linking Macros to Onedrive

I am trying to save file macro to my teams one drive. This is a shift report with multiple users that I want to put a "save a copy" button on so when we hit save it creates a pdf in a folder on our drive that is Timestamped with Date, Shift, and Supervisor. Below is what I've been able to get from a tutorial website. I have the URL for the share drive folder I want these to end up in. I need some help figuring out where to plug it in at. Right now when I run the macro it will create a prompt with the file name and where it was saved to. The location looks correct, but when I got to check that location on the SharePoint the file is non existent.
Thanks in advance,
Chris
``Sub PDFActiveSheetNoPrompt()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("B1").Value _
& " - " & wsA.Range("B2").Value _
& " - " & wsA.Range("B3").Value
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
exitHandler:
Exit Sub
errHandler`:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I have tried plugging the URL from https....to the "/" following the last location into the file path in the declaration of "StrPath", and into both "wbA" and "path" on wbA.Path. I'm not sure what else I can change the code to in this macro without causing an error somewhere else.
The easiest way is to make the target folder available in your One Drive app then use the local path to save the file.

Modify created macro to print array of sheets instead of Activesheet

I have a Macro that i have managed to put together (its rough, and im new to VBA but it does what i want - for the most part) It currently prints the active sheet to PDF and names it based on cell values. I want to adapt this to print 2 sheets into a single file (if its separate files, thats more than ok!) The cell Value naming bit can be changed at the top which i can do, but its calling for the export to pdf bit that im having an issue with.
I have tried reading up on the Activeworkbook functions but im not having much luck. I have tried calling for a sheet array, but it doesnt like the exportasfixedformat Type:= and im kind of new to that part too. It likes it in the original code, but not when i try and change the ActiveWorkbook.ActiveSheet, it spits it.
It would finalise my calculator :) Any help would be greatly appreciated.
Code:
Sub GetFilePath_Click()
Dim FileAndLocation As Variant
Dim strFilename As String
strFilename = Sheets("Leave Loading").Range("F13") & ", " & Sheets("Leave Loading").Range("F12") & " - " & Sheets("Leave Loading").Range("F14") & "- " & "Leave Loading" & ".pdf"
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a Location to Save")
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename, OpenAfterPublish:=True
End Sub
Thank you in advance!
Option Explicit
Sub GetFilePath_Click()
Dim FileAndLocation As Variant
Dim strFilename As String, strPathLocation As String
strPathLocation = ""
With Sheets("Leave Loading")
strFilename = .Range("F13") & ", " & .Range("F12") & " - " _
& .Range("F14") & "- Leave Loading" & ".pdf"
End With
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a Location to Save")
Sheets(Array("Sheet2", "Sheet4")).Select
Sheets("Sheet2").Activate
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename, OpenAfterPublish:=True
End Sub

VBA Excel - Export PDF file from Excel with second page

Just want to ask if how can I export a PDF file with vba? The thing is I do have a 10-F and 10-B sheet. The code below is working in the 10-F sheet. My problem is how can I export the data in the 10-B sheet together with the 10-F? The first page is the data in 10-F while the data in 10-B will be on the second page.
The range for the 10-B sheet is "B10:AD92".
Sub Ver_PDF()
'Create and assign variables
Dim saveLocation As String
Dim rng As Range
lname = ThisWorkbook.Sheets("HOME").Range("K12")
fname = ThisWorkbook.Sheets("HOME").Range("K13")
Name = fname & " " & lname
pdfile = "V-" & Name & ".pdf"
saveLocation = ThisWorkbook.Path & "\V-PDF\" & pdfile
Set rng = Sheets("10-F").Range("B9:AD89")
Dim strFileExists As String
strFileExists = Dir(saveLocation)
If strFileExists <> "" Then
Dim Ret
'~~> Change this to the relevant file path and name
Ret = IsFileOpen(saveLocation)
If Ret = True Then
MsgBox "Please close the PDF file before proceeding...", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
End If
rng.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=saveLocation, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Any help is highly appreciated! Thanks!
This code will do what you want. Change the worksheet names in the array as well as the destination path and file name.
Sub ExportAsPDF()
Dim FolderPath As String
Dim FileName As String
FolderPath = "D:\Test PDFs\" ' change to suit: end on back-slash
FileName = "Test" ' change to suit
On Error Resume Next
MkDir FolderPath
On Error GoTo 0
Worksheets(Array("10-F", "10-B")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FolderPath & FileName & ".PDF", _
OpenAfterPublish:=True, _
IgnorePrintAreas:=False
MsgBox "PDF was successfully created."
Worksheets(1).Select
End Sub
Change OpenAfterPublish to False if you don't want to see the result right away.

VBA to create folder from data validation list and allow user to select folder

I am encountering three problems with my code.
When users select a save folder it always saves in the folder above. For example, if the address is "Dept\Financial Analysis Team - General\Mail Out", it will always save to the Financial Analysis Team - General folder even though the Mail Out is the folder I have clicked.
I keep getting prompts to save with each time it loops. My macro loops through a data validation list, creates a folder (if none) and saves the specified PDF into their respective folders. The user is be able to select any folder they want in the selected Drive I have chosen.
If I do not select a folder (i.e. cancel), the macro runs on its own and actually creates the folder and PDF.
Function selectfolder()
user_name = Environ("username")
Dim flder As FileDialog
Dim foldername As String
Set flder = Application.FileDialog(msoFileDialogFolderPicker) 'standard wording
'Prompt for folder creation
With flder
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Dept\"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode 'i.e. if OK is not pressed
foldername = .SelectedItems(1)
End With
NextCode:
GetFolder = foldername
Set flder = Nothing
End Function
Sub SaveActiveSheetAsPDF()
'Creating a message box to ask user
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub
Dim inputrange As Range
Dim cell As Range
Dim network, Address, Folder, Title As String
'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)
For Each cell In inputrange
Range("G2").Value = cell.Value
'Defining the Network Folder variables
network = Range("C6").Value
Address = selectfolder
Folder = Address & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"
'Creating the folder based on Network - No existing folder
If Dir(Folder, vbDirectory) = "" Then
'Create a folder
MkDir Folder
'Save Active Sheet as PDF and to Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Folder & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Creating Only the PDF based on Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Folder & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
End If
Next cell
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"
End Sub
I suggest you break in your code at different parts to see what the variables are. (To add a breakpoint, click in gray area along left to add a red circle.)
Folder = Address & network
Your "Address" variable likely doesn't end in a slash, so I'm guessing you'll need something like: Address & "\" & network
If you break on the line that creates the pdf, in the debug window you can type
?Folder & "\" & Title & ".pdf"
which will likely show why your files are not being saved in the location you are intending. You could also create a variable saveAs to store the full path, making it easier to see the value.
You should move the code to ask user for directory toward the top, outside of your for loop. I assume you only need to ask for a directory once.
If the user doesn't select a folder, you want to exit, but you don't have code to handle this. Something like below should work:
address = SelectFolder
If address = "" Then
MsgBox "Canceled."
Exit Sub
End If
This is the correct code revised :)
Option Explicit
Function selectfolder()
Dim user_name As String
user_name = Environ("username")
'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker) 'standard wording
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\" 'base directory to open
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)
End With
End Function
Sub SaveActiveSheetAsPDF()
'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub
'Defining the Type of Variables
Dim inputrange As Range
Dim cell As Range
Dim network, Address, Fldr, Title As String
'If user does not choose a folder
Address = selectfolder
If Address = "" Then
Exit Sub
End If
'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)
For Each cell In inputrange
Range("G2").Value = cell.Value
'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"
'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fldr & "\" & Title & ".pdf", _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
End If
Next cell
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"
End Sub

Problem with VBA print to pdf error code in windows 10 environment

I have code which works fine in windows 7 and other windows version environments, but when some of the users have been upgraded to Windows 10 (myself included)
This is a macro enabled sheet which has worked fine for 3 years, and as far as I can tell the only change is the 'upgrade' to windows 10!
this is the bit of code which seems to fail:
'saveas function for pdf
ws.range("A1:K69").ExportAsFixedFormat Type:=xlTypePDf, _
filename:=path & fname, _
Quality:-xlqualityStandard, _
IncludeDocProperties:=True' _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
I get a Run-Time error Method 'ExportAsFixedFormat' of Object 'Range' failed. But when someone in an earlier windows environment runs the code it works perfectly and I get the pdf created, saved and opened for the user to insert other documents into.
Driving me mental, and I cannot work out why this would fail - and also sporadically as well.
I use the below to auto save an excel sheet as PDF, should try and save it to the excel file location and name it after the tab name.
If you set a print area on the sheet for the range you want to view in the PDF first, it should work :)
Hope it helps
Sub Export_Summary()
'
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

Resources