I am trying to write a macro to save an excel file in a defined location, using a value in a cell as the title in the format .xlsm, it appears to work but does not actually save the file? i am not sure what i have done wrong? here is the macro:
Sub Savefileas()
ThisFile = Range("B4").Value
Dim varResult As Variant
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Macro Enabled Workbook" & "(*.xlsm), *xlsm", Title:=Range("B4").Value &".xlsm", _
InitialFileName:="C:\Work\" & ThisFile & ".xlsm")
End Sub
Thanks in adavce
Give this a try. Error catching has also been added.
Sub Savefileas()
Dim ThisFile As String
Dim varResult As Variant
ThisFile = Range("B4").Value
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Macro Enabled Workbook" & "(*.xlsm), *xlsm", Title:=ThisFile & ".xlsm", InitialFileName:="C:\My Documents\" & ThisFile & ".xlsm")
With ActiveWorkbook
On Error GoTo message
.SaveAs varResult & ".xlsm", FileFormat:=52
Exit Sub
message:
MsgBox "There is an error"
End With
End Sub
Related
My code is suppose to check cell j2 for an email address and if found, convert that specific tab to pdf and save it in a file path that the user chooses. It works fine on the original workbook I made the macro in. When I copy the code and try running it, it prints to pdf different sheets that don't even have anything in j2 with the incorrect tab name. I keep getting an Run time error 5 Invalid procedure call or argument when i run the code on the print pdf line.
Sub SaveSheetsAsPDF()
Dim DestFolder As String
Dim PDFFile As String
Dim wb As Worksheet
Dim AlwaysOverwritePDF As Boolean
'Speed up macro
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
DestFolder = .SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With
'Create new PDF file name including path and file extension
For Each wb In ThisWorkbook.Worksheets
'Test j2 for a mail address
If wb.Range("J2").Value Like "?*#?*.?*" Then
PDFFile = DestFolder & Application.PathSeparator & wb.Name & "-" & Format(Date, "mmyy") & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
End If
'Prints PDF
wb.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next wb
MsgBox "All Files Have Been Converted!"
ResetSettings:
'Resets optimization settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Edit: Also not all worksheets on the workbook will need to converted. So only the sheets that need to be converted will have the email address in J2.
I am trying to create backup copy of workbook .xlsm and save it as .xlsx
due to the same issue as here: Run time error '1004': Copy method of worksheet class failed - Temp file issue
I cannot use SaveCopyAs along with changing format of file
My workaround was to
create new copy of .xlsm file
open this new copy
save it as .xlsx
Close .xlsx file
Remove file from step 1
this is my code
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo ErrorHandler:
'define variables
Dim backupfolder As String
Dim strFileName As String
Dim xlsxStrFileName As String
Dim fullPath As String
Dim xlsxFullPath As String
Dim wkb As Workbook
'get timestamp
dt = Format(CStr(Now), "yyyymmdd_hhmmss")
'construct full path to backup file which will be later converted to .xlsx
backupfolder = "c:\work\excel macro\delete\"
strFileName = "Test_iz_" & dt & ".xlsm"
fullPath = "" & backupfolder & strFileName
xlsxStrFileName = "Test_iz_" & dt & ".xlsx"
xlsxFullPath = "" & backupfolder & xlsxStrFileName
ActiveWorkbook.SaveCopyAs Filename:=fullPath
Set wkb = Workbooks.Open(fullPath)
wkb.Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=xlsxFullPath, FileFormat:=51 'saves the file
Application.DisplayAlerts = True
'Application.Wait (Now + TimeValue("00:00:03"))
ActiveWorkbook.Close
Kill fullPath
Exit Sub
ErrorHandler:
MsgBox "An error occured " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description
MsgBox "Backup saved: " & xlsxFullPath
ActiveWorkbook.SaveAs Filename:=fullPath
End Sub
My problem is that i always end up in ErrorHandler, even though i got expected result
When i comment out line 2
On Error GoTo ErrorHandler:
error Run-time error '91': Object variable or With block variable not set
on Debug, it points to row with the code
wkb.Activate
and .xlsm file is not deleted
I guess the problem is that when i create new copy of xlsm file and save it, this entire code would be executed one more time and that issue is there somewhere, but i cannot find it.
Thank you
This worked on my computer:
Sub Workbook_BeforeSave()
On Error GoTo ErrorHandler:
'define variables
Dim backupfolder As String
Dim strFileName As String
Dim xlsxStrFileName As String
Dim fullPath As String
Dim xlsxFullPath As String
Dim wkb As Workbook
'get timestamp
dt = Format(CStr(Now), "yyyymmdd_hhmmss")
'construct full path to backup file which will be later converted to .xlsx
backupfolder = "c:\work\excel macro\delete\"
strFileName = "Test_iz_" & dt & ".xlsm"
fullPath = "" & backupfolder & strFileName
xlsxStrFileName = "Test_iz_" & dt & ".xlsx"
xlsxFullPath = "" & backupfolder & xlsxStrFileName
ActiveWorkbook.SaveAs Filename:=fullPath, FileFormat:=52
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=xlsxFullPath, FileFormat:=51 'saves the file
Application.DisplayAlerts = True
ActiveWorkbook.Close
Kill fullPath
Exit Sub
ErrorHandler:
MsgBox "An error occured " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description
MsgBox "Backup saved: " & xlsxFullPath
ActiveWorkbook.SaveAs Filename:=fullPath
End Sub
Cheers,
Jonathan
I have the code below. It makes me wonder why the BeforePrint event in the workbook codes is fired even though I am not printing anything. The workbook definitely is not blank. The error is in the creation of the PDF file.
The file does a simple job of saving the worksheet in a PDF format with the name of the sheet, the file path of the workbook, and some details inside the worksheet.
Anything that I am missing? I am not new to VBA but this bugs me a lot today. I am using MS Excel 2016 on Windows 7 ultimate.
Edit: I tried removing the following codes below but the problem still persists:
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
The code is as follows:
Option Explicit
Public Sub createpdffile()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim sheetname As String, sheetcode As String
Dim iRow As Long
Dim openPos As Integer
Dim closePos As Integer
'temporarily disable error handler so that I can see where the bug is.
'On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
wbA.Save
'get last row of sheet and set print area to last row with L column
iRow = wsA.Cells(Rows.Count, 1).End(xlUp).Row
wsA.PageSetup.PrintArea = wsA.Range("A1:L" & iRow).Address
'just checking name in sheet and removing needed characters
sheetname = wsA.Name
openPos = InStr(sheetname, "(")
closePos = InStr(sheetname, ")")
sheetcode = Mid(sheetname, openPos + 1, closePos - openPos - 1)
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'create default name for saving file
strFile = sheetcode & " No. " & wsA.Cells(11, 9) & " - " & wsA.Cells(8, 3) & ".pdf"
strPathFile = strPath & strFile
'use 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
'THIS IS WHERE THE ERROR IS LOCATED
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'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" & vbNewLine & _
"Please complete the details needed!", vbOKOnly + vbExclamation, "Error Saving as PDF"
Resume exitHandler
End Sub
Solution from Foxfire and Burns and Burns' idea:
I added a public declaration before the main sub.
Option Explicit
'added line
Public myboolean as Boolean
Public Sub createpdffile()
myboolean = True
....
Then I added a line in the BeforePrint Event that says:
If myboolean = True Then Exit Sub
This now bypasses the BeforePrint event when the virtual PDF printer is called.
wsA.ExportAsFixedFormat
That line activates the BeforePrint Event. Actually, you are printing a PDF file. It works as a virtual PDF Printer.
I'm stepping through the code to export a module using this post, but nothing happens. Is there a security setting to allow VBA permission to export a module?
I'm copying a few tabs from a workbook into a new workbook, but the tabs have macros which lead to broken links. To get around this I want to move the module and re-associate the macro. If I can't get this to work I will just copy the whole workbook and delete the info I don't want in the destination.
Here's the code from the above post:
Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)
' Description: copies a module from one workbook to another
' example: CopyModule Workbooks(ThisWorkbook), "Module2",
' Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
' Notes: If Module to be copied already exists, it is removed first,
' and afterwards copied
Dim strFolder As String
Dim strTempFile As String
Dim FName As String
If Trim(strModuleName) = vbNullString Then
Exit Sub
End If
If TargetWB Is Nothing Then
MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
Exit Sub
End If
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
' create temp file and copy "Module2" into it
strFolder = strFolder & "\"
strTempFile = strFolder & "~tmpexport.bas"
On Error Resume Next
FName = Environ("Temp") & "\" & strModuleName & ".bas"
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
MsgBox "Error copying module " & strModuleName & " from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
Exit Sub
End If
End If
' remove "Module2" if already exits in destination workbook
With TargetWB.VBProject.VBComponents
.Remove .Item(strModuleName)
End With
' copy "Module2" from temp file to destination workbook
SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
TargetWB.VBProject.VBComponents.Import strTempFile
Kill strTempFile
On Error GoTo 0
End Sub
I have this code that creates a folder and a saves the actual file in it, but i want that it only saves a copy with only one sheet in it. So that the file with the code works like a template...
You write your stuff and press the button and it saves an .xlsx file with one sheet (the sheet with the form) in the new created folder... so you could do this with hundreds of files an folders.
So in the end it should work like this:
You open the .xlsm file where the code below is in.
You got to sheets one FORM (what should be "exported" later on) and
a list where you copy stuff in the form.
When you filled the form and press the button and it saves the Form
sheet in the new folder as .xlsx and you can continue in the .xlsm
file.
If it's unclear for you please ask.
The code i have now
Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Problem here is i have Names for the forms that are like 1102,1103 an going on like that. the next step is that there are files with the name 1102_1 and 1102_2 and they both should go in the folder 1102 ...
It's a bit out of my knownledge please help me guys :) greets
Now i am using this code below
Problem is that it always closes the xlsm file what really annoyes and when i reopen it it wants to update the file i need to remove that but i don't know how :/... and it only should export/save one special sheet
Private Sub CommandButton1_Click()
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("W12").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
WbCopy.Close
End Sub
Be careful on your variable declaration!
The way you did it in your OP (original post) :
strFilename, strDirname and strPathname are declared as Variant and not as String.
You can still use them BUT it'll take much more memory and can be issue if you use them as arguments.
See the code :
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ClosingWb = MsgBox("Do you wish to close the exported file?",vbYesNo,"Close exported file")
If ClosingWb <> vbNo Then WbCopy.Close