Need help on opening another workbook on the network - vba

Can you please help me figure this out?
I need to run some code on a workbook (A) to open couple other workbooks (B, C, D, & E) on the network. And these other workbooks are constantly being used by other people. So I have no problem opening these other workbooks... If these workbooks are currently being used by other people it will open as read only.
My problem is if I have any of these workbooks (B, C, D, & E) opened on my computer. The code will attempt to reopen these workbooks, and this will trigger a message saying this:
"B.xlsm is already open. Reopening will cause any changes you made to be discarded. Do you want to reopen B.xlsm?"
Click YES will close existing workbooks (B) without saving and reopen it.
Click NO will pop up this Run-time error' 1004": Method 'Open of object Workbooks' failed.
How do I alter this code so that if workbooks (B, C, D, & E) is opened on my computer (Opened by me and not Read only), it will continue the code without re-opening it?
Can you geniuses please help me figure this out ???
My Code:
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Sub test2()
Dim FolderPath As String
Dim filePath As String
Dim wBook As String
FolderPath = Application.ActiveWorkbook.Path
filePath = Left(FolderPath, InStrRev(FolderPath, "\") - 1)
wBook = filePath & "\Appeals 01.xlsm"
'If Workbook is Opened
If IsWorkBookOpen(filePath & "\Appeals 01.xlsm") Then
If MsgBox("Appeal 01 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
End If
MsgBox ("Continue Code")
End Sub
Hope you could help me... Thank you guys :)
Updated: Thanks to Tbizzness, I have revised my code to this:
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Sub test2()
Dim FolderPath As String
Dim filePath As String
Dim wBook As String
FolderPath = Application.ActiveWorkbook.Path
filePath = Left(FolderPath, InStrRev(FolderPath, "\") - 1)
wBook = filePath & "\Appeals 01.xlsm"
'Set Boolean to True if it's open on my computer
For Each WB1 In Application.Workbooks
If WB1.Name = "Appeals 01.xlsm" Then
Appeal01bool = True
ElseIf WB1.Name = "Appeals 02.xlsm" Then
Appeal02bool = True
End If
Next
'If Appeal 01.xlsm is not open on my computer
If Appeal01bool = False Then
'Then is it opened by others
If IsWorkBookOpen(filePath & "\Appeals 01.xlsm") Then
'If it is opened by others, do you want to open as Read-only?
If MsgBox("Appeal 01 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
'Yes to open as read-only
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 01.xlsm"
End If
'Save workbbook first if it is opened on this computer
Workbooks("Appeals 01.xlsm").Save
End If
'If Appeal 02.xlsm is not open on my computer
If Appeal02bool = False Then
'Then is it opened by others
If IsWorkBookOpen(filePath & "\Appeals 02.xlsm") Then
'If it is opened by others, do you want to open as Read-only?
If MsgBox("Appeal 02 is Opened. Do you want to open workbook as Read only?" & vbNewLine & vbNewLine & _
"Warning!!! Running numbers on Read-only mode can cause report not total correctly", vbYesNo, "Already Opened") = vbNo Then Exit Sub
'Yes to open as read-only
Workbooks.Open FileName:=filePath & "\Appeals 02.xlsm"
Else
Workbooks.Open FileName:=filePath & "\Appeals 02.xlsm"
End If
'Save workbbook first if it is opened on this computer
Workbooks("Appeals 02.xlsm").Save
End If
MsgBox ("Continue Code")
End Sub

I would use a simple for look to check all the titles of the open workbooks and set a boolean to true if it is open, then check the boolean before opening any workbooks:
for each wb in application.workbooks
if wb.name = b then
bbool = True
elseif wb.name = c then
cbool = True
elseif wb.name = d then
dbool = True
elseif wb.name = e then
ebool = True
end if
Next
if bbool = false then application.workbooks.open(b)
if cbool = false then application.workbooks.open(c)
if dbool = false then application.workbooks.open(d)
if ebool = false then application.workbooks.open(e)

Related

Merge Files In Excel

I have input some VBA code which is meant to aid in merging files into a single Excel file. When I run the macro, I get an error message.
I have created the main file and also the macro from code source online.
Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(FileName:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub
What is meant to happen when the macro is run is a window pops up asking to select the files to be merged. None may be open or even in memory, but I don't even get to a selection window. Instead I get an error message which says Method 'GetOpenFileName' of object '_Application' failed saying runtime error 1004 .
I am running this in Excel for Mac 16.26 if that helps

Saving new Excel document as macro-free workbook without prompt

I'm using Excel 2010. I have an Excel macro-enabled template that has a data connection to a text file that is set to automatically refresh when a new document is created using this template.
The following macro is within the "ThisWorkbook" object to remove the data connection before saving the new document:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
End Sub
When a user clicks the save icon / hits ctrl+S, inputs a filename and then clicks save to save as a macro-free Excel workbook (as is the default and required filetype) they are prompted with a message stating:
The following features cannot be saved in macro-free workbooks:
• VB project
To save a file with these features, click No, and then choose a
macro-enabled file type in the File Type list.
To continue saving as a macro-free workbook, click Yes.
Is it possible to prevent this message from appearing and have Excel assume that the user wants to continue with a macro-free workbook?
I've searched all over and understand that I may be able to add code to the workbook object that removes itself so that Excel has no VB project to cause this message but this would require each user to change Trust Center Settings (Trust access to the VBA project object model) which I want to avoid.
I've also seen suggestions of using:
Application.DisplayAlerts = False
but can't get this to work. Every example of it's use seems to be within a sub that is also handling the saving of the document whereas in my situation the BeforeSave sub ends before the document is saved in the default, non-vba way which is perhaps why it does not work?
Does this property reset to a default True after the sub has ended / before the save actually occurs?
Apologies for any nonsense I may have dispensed, my experience with VBA is very limited.
I cannot test on Excel 2010, but at least for 2016, it's working fine:
Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:\he\Path\you\prefer\"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Give it a try.
Different approach... when the template is loaded, require the user to save as (I have a workbook/template with a similar situation...). This should open them up to the user's Documents folder, though you can adjust to save to whatever location.
Inside of the ThisWorkbook module, put:
Option Explicit
Private Sub Workbook_Open()
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Edit1: Adding the if statement using a base-template name, so subsequent saves do not prompt the save-as:
Option Explicit
Private Sub Workbook_Open()
If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End If
End Sub
For this answer, I'm assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by "new document" is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn't been saved yet).
To solve your issue, you could use a custom SaveAs window (Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSave event macro gets called.
Here is how to implement it:
1 - Copy this code into a new module.
Option Explicit
Sub SaveAsCustomWindow()
Const C_PROC_NAME As String = "SaveAsCustomWindow"
Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
Dim UserInput1 As Variant, UserInput2 As Variant
Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
Dim strFilename As String, strFilePath As String
'To avoid Warning when overwriting
Application.DisplayAlerts = False
'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
Application.EnableEvents = False
On Error GoTo ErrHandler
'Customizable section
strDefaultName = ThisWorkbook.Name
strPreferedFolder = Environ("USERPROFILE")
Do While isWorkbookClosed = False
Do While isFileClosed = False
Do While isValidName = False
UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")
If UserInput1 = False Then
GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
Else
strFullFileName = UserInput1
End If
strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
strDefaultName = strFilename
strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
strPreferedFolder = strFilePath
'If the file exist, ask for overwrite permission
If Dir(strFullFileName) <> "" Then
UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
If UserInput2 = vbNo Then
isValidName = False
ElseIf UserInput2 = vbYes Then
isValidName = True
ElseIf UserInput2 = vbCancel Then
GoTo ClosingStatements
Else
GoTo ClosingStatements
End If
Else
isValidName = True
End If
Loop
'Check if file is actually open
If isFileOpen(strFullFileName) Then
MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the workbook before saving.", vbExclamation
isValidName = False
isFileClosed = False
Else
isFileClosed = True
End If
Loop
'Check if an opened workbook has the same name
If isWorkbookOpen(strFilename) Then
MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
isValidName = False
isFileClosed = False
isWorkbookClosed = False
Else
isWorkbookClosed = True
End If
Loop
ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook
ClosingStatements:
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrHandler:
Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
"While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
GoTo ClosingStatements
End Sub
Function isFileOpen(ByVal Filename As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open Filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isFileOpen = False
Case 70: isFileOpen = True
End Select
End Function
Function isWorkbookOpen(ByVal Filename As String) As Boolean
Dim wb As Workbook, ErrNo As Long
On Error Resume Next
Set wb = Workbooks(Filename)
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isWorkbookOpen = True
Case Else: isWorkbookOpen = False
End Select
End Function
Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEvents is turned back to TRUE even if an error occurs. Otherwise, all event macros will be disabled in your Excel application.
2 - Call the SaveAsCustomWindow procedure inside the Workbook_BeforeSave event procedure like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub
Note that we need to set the variable Cancel = True in order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has never been saved.
To answer your questions:
Is it possible to prevent this message from appearing?
Yes, using the Application.DisplayAlerts property
Is it possible to have Excel assume that the user wants to continue with a macro-free workbook?
No, you have to write the procedure to save the workbook and bypass the SaveAs excel event and save the workbook using the user input (Path & Filename) with the required format.
The following procedure uses a FileDialog to capture the Path and Filename from the user then saves the file without displaying the warning message.
I have added some explanatory comments nevertheless, let me know of any questions you might have.
Copy these procedures in the ThisWorkbook module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True 'Prevents repetitive Save
Call Workbook_BeforeSave_ApplySettings_And_Save
End Sub
Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String
Rem Sets FileDialog to capture user input
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialView = msoFileDialogViewDetails
.Title = vbNullString 'Resets default value in case it was changed
.ButtonName = vbNullString 'Resets default value in case it was changed
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub 'User pressed the Cancel Button
sFilename = .SelectedItems(1)
End With
With ThisWorkbook
Do While .Connections.Count > 0
.Connections.Item(.Connections.Count).Delete
Loop
Application.EnableEvents = False 'Prevents repetition of the Workbook_BeforeSave event
Application.DisplayAlerts = False 'Prevents Display of the warning message
On Error Resume Next 'Prevents Events and Display staying disable in case of error
.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook 'Saves Template as standard excel using user input
If Err.Number <> 0 Then
MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
& Err.Description & String(2, vbLf) _
& vbTab & "Process will be cancelled.", _
vbOKOnly, "Microsoft Visual Basic"
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End With
End Sub

Excel vba to solve vba error by "if error, then" rule

First of all, thanks for all the answers I have gotten on my previous questions, you really helped me out. The excel has evolved and now I'm ready to open different excel sheets in the background and print out different sheets on different printers. However, I'm working on a network that changes it's settings (which appear to change randomly).
Sub Client_Overzetten()
Application.ScreenUpdating = False
'
Workbooks.Open ("G:\Moe\WD\Planning&Control\Client.xlsm")
....etc...
However, if my colleague would try to open this file, he will get an error, as the same document has a different link (due to access restrictions).
His link is
G:\WD\Planning&Control\Client.xlsm")
Is there a formula to go to another location the moment it hits an error? Something like:
Sub Kids_II_Overzetten()
'
Application.ScreenUpdating = False
'
Workbooks.Open ("G:\Moe\WD\Planning&Control\Client.xlsm")
If error, then
Workbooks.Open ("G:\WD\Planning&Control\Client.xlsm")
I have the same problem with the serverports of the printer, these ports change randomly
ActivePrinter = "\\w8vvmprint01\Moecombi07 op Ne07:"
However, the next day it can be the same, or can be a different port
ActivePrinter = "\\w8vvmprint01\Moecombi07 op Ne03:"
With the solving of the problem of my first question, can I answer my second question as well (on error, go to the next line)?
Thanks in advance :)
For the network locations you'll need to use the UNC path which will not change rather than the mapped path which can change on different computers.
To find your UNC paths open a command prompt (Run - cmd.exe) and type in net use.
The resulting table will give the local and remote names of the drives- just replace your mapped (local) connection with the remote one.
For example,
G:\Moe\WD\Planning&Control\Client.xlsm
may become
\\MyServerName\Moe\WD\Planning&Control\Client.xlsm
Edit - the server name can also be found on the file explorer - windows key + E to open.
It will appear in the folder name as Moe on 'MyServerName' (G:)
To only use the mapped locations you could try:
Sub Test()
Dim wrkBk As Workbook
Dim sFileLocation As String
On Error GoTo ERROR_HANDLER
sFileLocation = "S:\Bartrup-CookD_SomeLocation\New Microsoft Excel Worksheet.xlsx"
Set wrkBk = Workbooks.Open(sFileLocation)
On Error GoTo 0
Exit Sub
ERROR_HANDLER:
Select Case Err.Number
Case 1004 'Microsoft Excel cannot access the file
sFileLocation = "S:\Bartrup-CookD\New Microsoft Excel Worksheet.xlsx"
Resume
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure Test."
Err.Clear
Application.EnableEvents = True
End Select
End Sub
or ask the user to select the correct file:
Public Sub AskForFile()
Dim vFile As Variant
Dim wrkBk As Workbook
vFile = GetFile("S:\Bartrup-CookD\")
If vFile <> "" Then
Set wrkBk = Workbooks.Open(vFile)
End If
End Sub
Public Function GetFile(Optional startFolder As Variant = -1) As Variant
Dim fle As FileDialog
Dim vItem As Variant
Set fle = Application.FileDialog(msoFileDialogFilePicker)
With fle
.Title = "Select a File"
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xls*", 1
If startFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function

Check if excel file is open, if yes close file,if no convert csv file to excel Visual Basic [duplicate]

This question already has answers here:
Detect whether Excel workbook is already open [closed]
(7 answers)
Closed 7 years ago.
I'm having a problem creating a condition. Please see pseudo code below. thanks in advance
Check if File A.xls is open
If File A.xls is Open
Close File A.xls
Else
Convert File A.csv to .xls
End If
Convert File A.csv to .xls
Dim DeleteEntries As Workbook
Dim WorksheetDeleteEntries As Worksheet
Dim WbOpen As Boolean
'Convert Acc_FR044_SAP.csv to excel
strDir = "C:\FR044 Automated Checker\"
strFile = Dir(strDir & "Acc_FR044_SAP.csv")
If Workbooks("Acc_FR044_SAP.xls") Is Nothing Then ' IM HAVING AN SUBSCRIPT ERROR IN THIS LINE
WbOpen = False
Else
Workbooks("Acc_FR044_SAP.xls").Close SaveChanges:=False
End If
Application.DisplayAlerts = False
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
Try with this solution which works for current instance of Excel:
On Error Resume Next
Dim tmpWB As Workbook
Set tmpWB = Workbooks("Acc_FR044_SAP.xls")
On Error GoTo 0
If tmpWB Is Nothing Then
WbOpen = False
Else
tmpWB .Close SaveChanges:=False
End If
Something like this to check if the file was open in any instance, on any machine
Sub Sample()
Dim bFileOpen As Boolean
bFileOpen = IsWorkBookOpen("C:\yourfilename.xlsx")
If bFileOpen Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If
End Sub
testing function from Microsoft example here
Function IsWorkBookOpen(FileName As String)
Dim ff As Long
Dim ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0
IsWorkBookOpen = False
Case 70
IsWorkBookOpen = True
Case Else
End Select
End Function

Excel VBA Open workbook, perform actions, save as, close

This question has been edited due to lengthy comments and updates from proposed answers.
As requested here is module 13;
Sub SaveInFormat()
Application.DisplayAlerts = False
Workbooks.Application.ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data\" & Format(Date, "yyyymm") & "DB" & ".xlsx", leFormat:=51
Application.DisplayAlerts = True
End Sub
Also there are issues with the errorhandling, I know I've gone wrong with it but I'm more interested in fixing the close function at the moment before I get into it. Here is the error handling code that needs some work
Sub test()
Dim wk As String, yr As String, fname As String, fpath As String
Dim owb As Workbook
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
owb = Application.Workbooks.Open(fpath & "\" & fname)
On Error GoTo ErrorHandler:
ErrorHandler:
If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then Exit Sub Else Call Clear
'Do Some Stuff
Call Module13.SaveInFormat
owb.Close
this is your test code plus my changing of the file path and name
After discussion posting updated answer:
Option Explicit
Sub test()
Dim wk As String, yr As String
Dim fname As String, fpath As String
Dim owb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
On Error GoTo ErrorHandler
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
'Do Some Stuff
With owb
.SaveAs fpath & Format(Date, "yyyymm") & "DB" & ".xlsx", 51
.Close
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
ErrorHandler: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
End Sub
Error Handling:
You could try something like this to catch a specific error:
On Error Resume Next
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
If Err.Number = 1004 Then
GoTo FileNotFound
Else
End If
...
Exit Sub
FileNotFound: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
I'll try and answer several different things, however my contribution may not cover all of your questions. Maybe several of us can take different chunks out of this. However, this info should be helpful for you. Here we go..
Opening A Seperate File:
ChDir "[Path here]" 'get into the right folder here
Workbooks.Open Filename:= "[Path here]" 'include the filename in this path
'copy data into current workbook or whatever you want here
ActiveWindow.Close 'closes out the file
Opening A File With Specified Date If It Exists:
I'm not sure how to search your directory to see if a file exists, but in my case I wouldn't bother to search for it, I'd just try to open it and put in some error checking so that if it doesn't exist then display this message or do xyz.
Some common error checking statements:
On Error Resume Next 'if error occurs continues on to the next line (ignores it)
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Or (better option):
if one doesn't exist then bring up either a message box or dialogue
box to say "the file does not exist, would you like to create a new
one?
you would most likely want to use the GoTo ErrorHandler shown below to achieve this
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
ErrorHandler:
'Display error message or any code you want to run on error here
Much more info on Error handling here: http://www.cpearson.com/excel/errorhandling.htm
Also if you want to learn more or need to know more generally in VBA I would recommend Siddharth Rout's site, he has lots of tutorials and example code here:
http://www.siddharthrout.com/vb-dot-net-and-excel/
Hope this helps!
Example on how to ensure error code doesn't run EVERYtime:
if you debug through the code without the Exit Sub BEFORE the error handler you'll soon realize the error handler will be run everytime regarldess of if there is an error or not. The link below the code example shows a previous answer to this question.
Sub Macro
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Exit Sub 'Code will exit BEFORE ErrorHandler if everything goes smoothly
'Otherwise, on error, ErrorHandler will be run
ErrorHandler:
'Display error message or any code you want to run on error here
End Sub
Also, look at this other question in you need more reference to how this works:
goto block not working VBA