Hey I fairly new at Excel and I am running into a problem with error handing. I want my macro to run and if it can not find the folder then it should produce a message to the users and exit sub. Any help would be greatly appreciated!
Below is my code on where my macro saves file
Worksheets("Input data").Visible = True
folder = "\\Group_SHARED\Group Shared\Engineering\Controlled Folder\Number_Checkout\Archived\Archived"
MyTime = Time
Sheets("Input data").Select
Range("G2").Value = MyTime
strFileName = folder & "_" & Sheets("Input data").Range("C6").Value & "_" & Sheets("Get_ECN").Range("B6").Value & "_" & Sheets("Input data").Range("C3").Value & " " & Sheets("Input data").Range("C4").Value
Worksheets("Input data").Visible = False
ActiveWorkbook.SaveAs Filename:=strFileName
Try:
If dir(folder) = "" then
Msgbox "no such directory"
Exit sub
end if
as in:
Sub Test()
folder = "C:\Users\Administrator\"
If Dir(folder) = "" Then
MsgBox "no such directory"
Exit Sub
Else
MsgBox "Yup, It's There All Right."
End If
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.
Wanting to check this Exit Sub at the top isn't going to cause me other problems. It seems to work, added to rest of my code for reference.
Everything from 'Establish File Extension type has worked to date/to this point. Unsure if just showing the below segment of code is sufficient to answer the question.
If invalid > 0 Then mbResult = MsgBox("Something's missing. Please check and try again. There are " & invalid & " incomplete fields.", _
vbOKOnly)
Select Case mbResult
Case vbOK
Exit Sub
End Select
'Establish File Extension type
With Destwb
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End With
FileExtStr = ".xlsm"
FileFormatNum = 52
'Save the new workbook and close it
TempFilePath = ("www.mysharepoint.com") & "\"
TempFileName = Range("A1").Text
'Confirm Submission
mbResult = MsgBox("This submission cannot be undone. Would you like to continue?", _
vbYesNo)
Select Case mbResult
Case vbNo
Exit Sub
End Select
'Build .SaveAs file Name based on variables established previously
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.DisplayAlerts = True
ThisWorkbook.Activate
'Display successful submission message
MsgBox ("Thank you, your assessment has been successfully submitted.")
ActiveSheet.Protect
End Sub
You can change these lines:
If invalid > 0 Then mbResult = MsgBox("Something's missing. Please check and try again. There are " & invalid & " incomplete fields.", _
vbOKOnly)
Select Case mbResult
Case vbOK
Exit Sub
End Selec
to this:
If invalid > 0 Then
MsgBox "Something's missing. Please check and try again. There are " & _
invalid & " incomplete fields.", vbOKOnly
Exit Sub
End If
This is my first time using VBA so I need help. This is a macro in Excel to convert a file from one Excel extension to another. I have starting converting this code from 32 bit to work in 64 bit and found online most the key parts to change but now it is giving me Compile Errors: Type mismatch and I have no idea what to change. Any help is appreciated.
The Error shows the yellow arrow at Sub loopConvert() and the cntToConvert as the blue highlighted section. Picture included.
Picture of Error
Option Explicit
'Created by David Miller (dlmille on E-E October, 2011)
'Feel free to use and share, please maintain appropriate acknowledgements the author and link where you found this code.
Sub loopConvert()
Dim fPath As String
Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String
Dim wBook As Workbook, fFilesToProcess() As String
Dim numconverted As LongPtr, cntToConvert As LongPtr, i As LongPtr
Dim killOnSave As Boolean, xMsg As LongPtr, overWrite As Boolean, pOverWrite As Boolean
Dim silentMode As Boolean
Dim removeMacros As Boolean
Dim fromFormat As String, toformat As String
Dim saveFormat As LongPtr
Dim wkb As Workbook, wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Control Panel")
removeMacros = IIf(wks.CheckBoxes("Check Box 1").Value = 1, True, False)
silentMode = IIf(wks.CheckBoxes("Check Box 2").Value = 1, True, False)
killOnSave = IIf(wks.CheckBoxes("Check Box 3").Value = 1, True, False)
fromFormat = wkb.Names("fromFormat").RefersToRange
toformat = wkb.Names("toFormat").RefersToRange
saveFormat = IIf(toformat = ".XLS", xlExcel8, IIf(toformat = ".XLSX", xlOpenXMLWorkbook, xlOpenXMLWorkbookMacroEnabled))
Application.DisplayAlerts = False 'no user prompting, taking all defaults
Application.ScreenUpdating = False
fPath = GetFolderName("Select Folder for " & fromFormat & " to " & toformat & " conversion")
If fPath = "" Then
MsgBox "You didn't select a folder", vbCritical, "Aborting!"
Exit Sub
Else
fName = Dir(fPath & "\*" & fromFormat)
If fName = "" Then
MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting"
Exit Sub
Else 'get a file count of files to be processed, then process them in the next step
Do
If UCase(Right(fName, Len(fromFormat))) = UCase(fromFormat) Then 'to differentiate between dir *.xls and inadvertently get *.xls???
ReDim Preserve fFilesToProcess(cntToConvert) As String
fFilesToProcess(cntToConvert) = fName
cntToConvert = cntToConvert + 1
End If
fName = Dir
Loop Until fName = ""
If cntToConvert = 0 Then 'we were looking for .XLS and there was only .XLS??? or nothing, then abort
MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting"
Exit Sub
End If
If Not silentMode Then
xMsg = MsgBox("There are " & cntToConvert & " " & fromFormat & " files to convert to " & toformat & ". Do you want to delete the " & fromFormat & " files as they are processed?", vbYesNoCancel, "Select an Option")
killOnSave = False 'already false, but just a reminder this is in here!
If xMsg = vbYes Then
killOnSave = True
ElseIf xMsg = vbCancel Then
GoTo processComplete
End If
Else
pOverWrite = True
End If
Application.EnableEvents = False 'turn off events so macros don't fire on excel file opens
For i = 0 To cntToConvert - 1 'process each file for conversion, displaying status as progress...
Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName
fName = fFilesToProcess(i)
'open and convert file
On Error GoTo errHandler
fOriginalFilePath = fPath & "\" & fName
'you could also check to see if the save as file already exists, before you open convert and save on top!
overWrite = False
fSaveAsFilePath = fPath & "\" & Mid(fName, 1, Len(fName) - Len(fromFormat)) & toformat
If Not pOverWrite Then
If FileFolderExists(fSaveAsFilePath) Then
xMsg = MsgBox("File: " & fSaveAsFilePath & " already exists, overwrite?", vbYesNoCancel, "Hit Yes to Overwrite, No to Skip, Cancel to quit")
If xMsg = vbYes Then
overWrite = True
ElseIf xMsg = vbCancel Then
GoTo processComplete
End If
Else
overWrite = True
End If
Else
overWrite = pOverWrite
End If
If overWrite Then
Set wBook = Application.Workbooks.Open(fOriginalFilePath)
If removeMacros And (toformat = ".XLS" Or toformat = ".XLSM") And (fromFormat <> ".XLSX") Then
'use Remove Macro Helper
Call RemoveAllMacros(wBook)
End If
wBook.SaveAs Filename:=fSaveAsFilePath, FileFormat:=saveFormat
wBook.Close savechanges:=False
numconverted = numconverted + 1
'optionally, you can delete the file you converted from
If killOnSave And fromFormat <> toformat Then
Kill fOriginalFilePath
End If
End If
Next i
End If
End If
processComplete:
On Error GoTo 0
MsgBox "Completed " & numconverted & " " & fromFormat & " to " & toformat & " conversions", vbOKOnly
Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Exit Sub
errHandler:
Application.StatusBar = False
MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!"
Resume processComplete
End Sub
Squidx3 helped me figure out that I needed to just change it. It works now Thanks!
From this:
Dim numconverted As LongPtr, cntToConvert As LongPtr, i As LongPtr
To this:
Dim numconverted As LongPtr, cntToConvert As Long, i As Long
GetFolderName isn't a native function. You copied this code from another place? Verify if getFolderName is there.
I have a very extensive program written in Excel VBA that works perfectly fine, except when it attempts to save. Occasionally, not necessarily every time, the macro will save the workbook (in this case, export to CSV), but be stuck with the window labeled 'Saving,' a status message claiming that it's saving my file and a progress bar that will not progress further. It also has a button labeled 'Cancel,' which, when pressed, will continue the macro since the file has already been saved.
Here is the subroutine that I'm using:
Sub exportTable()
Dim varIsOpen As Boolean
Dim varSaveLocation1 As String, varSaveLocation2 As String
varIsOpen = False
If ThisWorkbook.Sheets("ControlSheet").Range("D2").Value = "" Then
varSaveLocation1 = ThisWorkbook.Path & "\CSVREVIEW\"
varSaveLocation2 = varSaveLocation1 & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now)
Else
varSaveLocation1 = ThisWorkbook.Sheets("ControlSheet").Range("D2").Value
If Right(varSaveLocation1, 1) <> "\" Then varSaveLocation1 = varSaveLocation1 & "\"
varSaveLocation2 = varSaveLocation1 & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now)
End If
For counter = 1 To Workbooks.Count
If Workbooks(counter).Name = "TableBook.xls" Then varIsOpen = True
If varIsOpen = True Then Exit For
Next
If varIsOpen = False Then GoTo isClosed
Workbooks("TableBook").Activate
'On Error Resume Next
If Len(Dir(varSaveLocation1, vbDirectory)) = 0 Then
MkDir varSaveLocation1
End If
If Len(Dir(varSaveLocation2, vbDirectory)) = 0 Then
MkDir varSaveLocation2
End If
'On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("test").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\test", xlCSV
ActiveWorkbook.Sheets("part").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\part", xlCSV
ActiveWorkbook.Sheets("logFile").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\logFile", xlCSV
ActiveWorkbook.Sheets("deltaLimits").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\deltaLimits", xlCSV
ActiveWorkbook.Close
Application.DisplayAlerts = True
isClosed:
End Sub
It may also be worth noting that I am currently saving to a server, but can't really remember if it did this while testing it on a local directory.
How can I get it to not hang? What is the cause of this problem and/or the solution to it?
I had this start happening to my sheet - a pair of doevents around the .saveas fixed this for me. I don't know why this is needed, or why it works, I saw it on a post (which I now cannot find).
It seems like the problem was actually just that it was saving to a server location. Saving locally ran the program flawlessly.
Thank you #TonyDallimore for the suggestion.
I want a msgbox to show "File not found" when the file TestData.xlsx is not found. Thanks
Sub check()
Dim i As Long
'~~> From Row 5 to row 10
'~~> Chnage as applicable
For i = 5 To 10
Sheets("Sheet1").Range("F" & i).Formula = _
"=VLookup((CONCATENATE(C1,"" "",C" & i & _
")),'C:\Documents[TestData.xlsx]Sheet1'!$A$2:$G$28,7, FALSE)"
Sheets("Sheet1").Range("F" & i).Value = Sheets("Sheet1").Range("F" & i).Value
Next i
End Sub
Do a check for the file before your for loop:
If Dir$("C:\Documents\TestData.xlsx") = "" Then
MsgBox "File not found"
Exit Sub
End If
Add a reference to "Microsoft Scripting Runtime"
and then:
Dim fso As New FileSystemObject
If Not fso.FileExists("C:\Documents\TestData.xlsx") Then MsgBox "File Not Found."
This will work.
Sub test()
sPath = "C:\Documents\TestData.xlsx"
'Test if directory or file exists
If File_Exists(sPath) Then
MsgBox sPath & " exists!"
Else
MsgBox sPath & " does not exist."
End If
End Sub
Private Function File_Exists(ByVal sPathName As String,
Optional Directory As Boolean) As Boolean
'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then
If IsMissing(Directory) Or Directory = False Then
File_Exists = (Dir$(sPathName) <> "")
Else
File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If
End If
End Function
This is from the second google result of "vba test if file exists" http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html