Being an absolute VBA novice, I've pieced together some code that will run through an Excel sheet, checking everything's there, and then saving the sheet as a PDF file. I am, however, having some trouble with the saving part of the code. I keep getting the error "Compile error: Expected:=" to this line:
`Wsa.ExportAsFixedFormat(Type:=xlTypePDF,Filename:=myFile,Quality:=xlQualityStandard,IncludeDocProperties:=True,IgnorePrintAreas:=False, OpenAfterPublish:=False)ยด
Am I just being a complete n00b here?
The whole thing looks like this:
Sub mcrSave()
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
'Check for mandatory fields
If Range("B3").Value = "" Then MsgBox ("Please fill in applicant")
Exit Sub
If Range("C1").Value = "" Then MsgBox ("Please fill in project title")
Exit Sub
If Range("H3").Value = "" Then MsgBox ("Please fill in date of application")
Exit Sub
If Range("C5").Value = "" Then MsgBox ("Please fill in expected cost")
Exit Sub
If Range("C7").Value = "" Then MsgBox ("Please fill in time schedule")
Exit Sub
If Range("B10").Value = "" Then MsgBox ("Please fill in project description")
Exit Sub
If Range("B18").Value = "" Then MsgBox ("Please fill in potential benefits")
Exit Sub
If Range("B26").Value = "" Then MsgBox ("Please fill in potential drawbacks")
Exit Sub
If Range("B34").Value = "" Then MsgBox ("Please fill in internal/external ressources")
Exit Sub
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
'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
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
Syntax error. The correct syntax is either
call Wsa.ExportAsFixedFormat(Type:=xlTypePDF,Filename:=myFile,...)
or
Wsa.ExportAsFixedFormat Type:=xlTypePDF,Filename:=myFile,...
Change your Export command to the following:
Wsa.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Also, you need to change your Mandatory field checks so each looks like:
If Range("B3").Value = "" Then
MsgBox ("Please fill in applicant")
Exit Sub
End If
Related
I have code that run when file Opens that renames file data in Inputbox using ActiveWorkbook.SaveAs. It works fine under following conditions.
Spreadsheet opened in "File Explorer"
Spreadsheet opened in Excel Browser screen.
When spreadsheet is opened thru Excel Open/Menu, Sub will not save new file at initial Open, but if I run sub after, no issues.
Private Sub Workbook_Open()
'Checks Status of Workbook upon Openning
Dim PON, INP As String
Dim strPath, JC As String
Dim strNewName, NewName As String
INP = Worksheets("CHK").Range("J1").Value
Worksheets("CHK").Range("Q1").Value = "Good"
Worksheets("Form").Select
Worksheets("Form").Range("C4").Select
Call Protect_All_Sheets_Pswrd
If INP = "New" Then
Call Save_PO_File
Else
If INP = "Done" Then
MsgBox "This Check List is COMPLETE!!!!!"
Call Save_PO_File
Else
Call PGUP_PGDN
UserForm2.Show
End If
End If
End Sub
Sub Save_PO_File()
Dim strPath As String
Dim strNewName, NewName As String
1000 On Error GoTo ErrorHandler
Answer = MsgBox("Do You want to start NEW Rental Checklist?", vbQuestion + vbYesNo + vbDefaultButton2)
If Answer = vbYes Then
Worksheets("CHK").Range("S6").Value = 0
PON = InputBox("Please enter PO Number to Start Checklist:", Xpos:=2880, Ypos:=1440)
If Len(PON) > 7 Then
MsgBox "PO number can only be a Maximum of 7 digits"
GoTo 1000
End If
If PON = "" Then
MsgBox "MUST ENTER PO#"
GoTo 1000
End If
strNewName = "Rental Checklist PO " + PON & ".xlsm"
strPath = ActiveWorkbook.Path
NewName = strPath & "\" & strNewName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NewName
Application.DisplayAlerts = True
If ActiveWorkbook.Name <> strNewName Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
End If
MsgBox strPath & "/" & vbNewLine & vbNewLine & strNewName, , "NEW Workbook Saved As"
Call Clean_Form 'Clear Form
Worksheets("Form").Range("C9").Value = PON 'Input PO #
Worksheets("Form").Range("C4").Select
Call PGUP_PGDN
Else
Call Confirm_ADMIN
End If
Exit Sub
ErrorHandler:
MsgBox "Had Error... Check File Name"
Exit Sub
End Sub
Tried different folders, adding error checking...etc
Ok, So i am trying to create a PDf and place it into a a folder that is named after cell E10 in which is side a folder of B18. I am getting a "Compile Error block If Without End If" I have tried both end and exit statements with no luck.
Function Dispatch_PDF() As Boolean ' Copies sheets into new PDF file for e-mailing
Dim Thissheet As String, ThisFile As String, PathName As String
Dim SvAs As String
Dim Tmp As String
Dim FldName As String
' 1. Create the name you want to search for before starting the search
' 2. don't refer to cells by their range names (too cumbersome)
FldName = Cells(10, 5).Value ' actually, it's Cells(10, 5)
Debug.Print FldName ' check the name
If Len(FldName) Then
Tmp = Cells(18, 2).Value
If Len(Tmp) Then
FldName = Tmp & "\" & FldName ' observe how to add the path separator
Debug.Print FldName ' check the name
FldName = ActiveWorkbook.path & "\DISPATCHED WORK ORDERS\" & FldName
Debug.Print FldName
Application.ScreenUpdating = False
' Get File Save Name
Thissheet = ActiveSheet.Name
ThisFile = ActiveWorkbook.Name
PathName = ActiveWorkbook.path
SvAs = PathName & "\DISPATCHED WORK ORDERS\" & FldName & Range("E10").Value & ".pdf"
'Set Print Quality
On Error Resume Next
ActiveSheet.PageSetup.PrintQuality = 600
Err.Clear
On Error GoTo 0
' Instruct user how to send
On Error GoTo RefLibError
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
On Error GoTo 0
SaveOnly:
MsgBox "A copy of this sheet has been successfully saved as a .pdf file: " & Chr(13) & Chr(13) & SvAs & _
"Review the .pdf document. If the document does NOT look good, adjust your printing parameters, and try again."
Dispatch_PDF = True
GoTo EndMacro
RefLibError:
MsgBox "Unable to save as PDF. Reference library not found."
Dispatch_PDF = False
EndMacro:
End Function
Any Suggestions?
Okay here it is. I've done a bunch of coding in the last 3 or 4 months, learned a lot, BUT, I can't figure out why this code STILL opens a file when I hit cancel at the end once the popup window comes up showing my filtered filenames. Any advice would be highly appreciated.
Sub OpenByPartialName()
' Returns popup window with only filtered filenames matching
' Partial Filename input
Dim WB As Workbook
Dim Ans As String
Dim MyFile As String
Dim path As String
' Folder Path Name for Forms
path = ("S:\Forms Folder\")
Ans = InputBox("Enter Partial filename Filter", "Open File With Partial Name Filter")
MyFile = Dir("S:\Forms Folder\" & "*" & Ans & "*.xls")
MyFilter = path & "*" & Ans & "*.xls"
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = MyFilter
If .Show = 1 Then
MyFile = .SelectedItems(1)
End If
End With
On Error Resume Next
Set WB = Workbooks.Open(MyFile)
End Sub
That would be a dirty hack, but if you had an Else branch here:
If .Show = 1 Then
MyFile = .SelectedItems(1)
Else
MyFile = vbNullString
End If
...the code that actually opens the file could verify whether MyFile is empty or not before trying:
On Error Resume Next
If MyFile <> vbNullString Then Set WB = Workbooks.Open(MyFile)
That said I think you should be handling at least error 53 ("file not found") here, instead of just shoving all errors under the carpet.
Also the WB reference isn't used. Perhaps the Sub should be a Function that returns the opened workbook, or Nothing if opening fails?
This is what I use to select a directory. If the function returns an empty string, I don't try to open the file.
Private Function FolderPicker() As String
'*******************************************
' returns directory path to be printed to
' does not allow multiple selections,
' so returning the first item in selected
' items is sufficient.
'
' returns empty string On Error or if the
' user cancels
'********************************************
On Error GoTo ErrHandler
Const DefaultDirectory As String = "C:Path\to\default\directory\"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Choose Directory to Print to"
.InitialFileName = DefaultDirectory
.InitialView = msoFileDialogViewSmallIcons
If .Show <> -1 Then
FolderPicker = vbNullString
Else
FolderPicker = .SelectedItems(1)
End If
End With
Exit Function
ErrExit:
FolderPicker = vbNullString
Exit Function
ErrHandler:
MsgBox "Unexpected Error: " & Err.number & vbCrLf & "Source: " & Err.Source & _
"Description: " & Err.Description, vbCritical, "ERROR!"
Resume ErrExit
End Function
So, you would call it like this.
MyFile = FolderPicker
If MyFile <> vbNullString Then
Set WB = Workbooks.Open(MyFile)
End If
Much blood, sweat and tears later (Serious web surfing, cobbling code together and retesting) I have found an answer that works without any problems for pressing 'Cancel' at any point.
Sub OpenAuditPartialName()
' Returns popup window with only filtered
' filenames matching input criteria.
' Filenames are saved from another code that uses 3 variables to generate a _
' filename 'Filename part1_Filename part2_Filename part3 Forms.xls'
Dim WB As Workbook
Dim Ans As String
Dim MyFile As String
Dim path As String
' Folder path for Forms
path = ("S:\Forms Folder\")
Ans = InputBox("Enter any part of the filename to search by." & vbCrLf & vbCrLf & _
"Full or Partial information is OK." & vbCrLf & vbCrLf & "Filename part1" _
& vbCrLf & "Filename part2" & vbCrLf & "Filename part3", "Enter Partial Filename Filter")
' Exits on 'Cancel' as it should
If Ans = "" Then
Exit Sub
End If
MyFile = Dir(path & "*" & Ans & "*.xls")
MyFilter = path & "*" & Ans & "*.xls"
'*******************************************
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = MyFilter
' Now accepts the 'Cancel' instead of continuing to open the first file
' in the filtered list when pressed
If .Show = 0 Then
ElseIf Len(Ans) Then
MyFile = .SelectedItems(1)
On Error Resume Next
Set WB = Workbooks.Open(MyFile)
Else
Exit Sub
End If
'*******************************************
End With
End Sub
I have written a sub that should save worksheet 2 as a csv file with a time stamp in it. I let the user choose the file path with the get path sub, then when the user clicks 'okay' the program fails and says
run time error 9, subscript out of range.
Can you please help me figure out where/why my program is diong this?
Public Sub save()
Dim x As Integer
Dim FName As String
x = MsgBox("Are you sure?!?", vbYesNo, "Send File")
If x <> vbYes Then
GoTo Send_file_end:
End If
FName = get_path & "cambs_uplaoded_trades" & Format(Time, "hh mm ss") & ".csv"
ActiveWorkbook.Worksheets("sheet2").SaveAs Filename:=FName, FileFormat:=xlCSV
MsgBox "saved "
Send_file_end:
End Sub
here is my get path function
Function get_path() As String
Dim dlg As Variant
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
dlg.AllowMultiSelect = False
If dlg.Show <> -1 Then
get_path = ""
Else
get_path = dlg.SelectedItems(1) & "\"
End If
End Function
So i'll show you my solution just in case your interested:
Sheets("Sheet2").Activate
FName = get_path & "cambs_uplaoded_trades" & Format(Time, "hh mm ss") & ".csv"
ActiveWorkbook.Worksheets("Sheet2").SaveAs Filename:=FName, FileFormat:=xlCSV
MsgBox "saved "
ActiveSheet.Name = "Sheet2"
Sheets("Sheet1").Activate
So i activated sheet two before the name was changed, then saved it, then i changed the name of the active workshet back to sheet2.
thanks for you input!
When entering data into a .txt to act as a log, it does get quite large, several MB, and the generic txt reader for MS will have a conniption. Is there a way to put a log into a folder that may or may not exist? So in other words, if a folder doesn't exist, create folder, and cut and paste old log into new folder?
Since I know there will be possibilities for multiple logs to be in said log folder, would there be a way to make it so that there is today's date attached to the log name as well?
Think I solved it...
If FileLen(sLogFileName) > 3145728# Then
sLogFileName = "Open Order Log - " & Format(Date, "dd-mm-yyyy")
Name sLogFileName As "ThisWorkbook.path & Application.PathSeparator & \Temp\Open Order Log - " & Format(Date, "dd-mm-yyyy")
End If
From your other question, it is obvious that you know how to create a log file.
And from your above question, I could summarize that this is your query
Check if a folder exists or not
Creating a Folder
Add Date to a log file's name
Checking the file Size
Moving a File
So let's take them one by one.
Check if a folder exists or not. You can use the DIR function to check for that. See example below
Public Function DoesFolderExist(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString Then _
DoesFolderExist = True
Whoa:
On Error GoTo 0
End Function
Regarding your next query, you can use MKDIR to create a folder. See this example
Sub Sample()
MkDir "C:\Sample"
End Sub
Regarding the third query, you can create a log file with a date appended to it like this
Sub Sample()
Dim FlName As String
FlName = "Sample File - " & Format(Date, "dd-mm-yyyy")
Debug.Print FlName
End Sub
To check for a file size, you can use the FileLen function. See this example
Sub Sample()
Dim FileNM As String
FileNM = "C:\Sample.txt"
Debug.Print "The File size of " & FileNM & " is " & _
FileLen(FileNM) & " bytes"
End Sub
And to move a file from one directory to the other you can use the NAME function. See this example.
Sub Sample()
Dim FileNM As String
FileNM = "C:\Sample.txt"
Name FileNM As "C:\Temp\Sample.txt"
End Sub
So now you can put all of these together to achieve what you want :)
FOLLOWUP (FROM CHAT)
This is what we finally arrived at
Option Explicit
Dim PreviousValue
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target(1).Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sLogFileName As String, ArchiveFileName As String
Dim ArchFolder As String, sLogMessage As String
Dim nFileNum As Long
Dim NewVal
On Error GoTo Whoa
Application.EnableEvents = False
sLogFileName = ThisWorkbook.path & Application.PathSeparator & _
"Open Order Log.txt"
If Not Target.Cells.Count > 1 Then
If Target.Value <> PreviousValue Then
'~~> Check if the Log File exists
If DoesFileFldrExist(sLogFileName) = True Then
'~~> Check for the File Size
If FileLen(sLogFileName) > 3145728 Then
'~~> Check if the "Log History" folder exists
ArchFolder = ThisWorkbook.path & _
Application.PathSeparator & "Log History"
'~~> If the "Log History" folder doesn't exist, then create it
If DoesFileFldrExist(ArchFolder) = False Then
MkDir ArchFolder
End If
'~~> Generate a new file name for the archive file
ArchiveFileName = ArchFolder & Application.PathSeparator & _
"Open Order Log - " & Format(Date, "dd-mm-yyyy") & ".txt"
'~~> Move the file
Name sLogFileName As ArchiveFileName
End If
End If
'~~> Check if the cell is blank or not
If Len(Trim(Target.Value)) = 0 Then _
NewVal = "Blank" Else NewVal = Target.Value
sLogMessage = Now & Application.UserName & _
" changed cell " & Target.Address & " from " & _
PreviousValue & " to " & NewVal
nFileNum = FreeFile
'~~> If the log file exists then append to it else create
'~~> a new output file
If DoesFileFldrExist(sLogFileName) = True Then
Open sLogFileName For Append As #nFileNum
Else
Open sLogFileName For Output As #nFileNum
End If
Print #nFileNum, sLogMessage
Close #nFileNum
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Public Function DoesFileFldrExist(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString _
Then DoesFileFldrExist = True
Whoa:
On Error GoTo 0
End Function
Sub MoveFiles()
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Dim MyFile As String
Inlocation = ws.Range("A1").Value & "\"
Lastdate = Format(ws.Range("A3").Value, "DD-MM-YYYY")
Outlocation = ws.Range("A2").Value
Foulocation = Outlocation & "\" & Lastdate
MyFile = Dir(Inlocation & "*.*")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Check Specified Folder exists or not
If Not oFSO.FolderExists(Foulocation) Then
'If Folder is available
MkDir Foulocation
End If
Do Until MyFile = ""
oFSO.CopyFile Inlocation & MyFile, Foulocation & "\", True
If Inlocation <> Foulocation Then
oFSO.DeleteFile Inlocation & MyFile
End If
'Name Inlocation & MyFile As Foulocation & "\" & MyFile
MyFile = Dir
Loop
MsgBox "Files successfully moved to location " & Foulocation
End Sub