Currently my code looks like this and it works fine
Dim WorkbookVar As Workbook
Dim Path As String
Path = "C:\Path.xlsx"
Set WorkbookVariable = Workbooks.Open (Filename:=MCDistroNumberPath)
But I would like it to go a step further and have an if statement saying If this workbook is already open Then skip it and start running the rest of my macro.
How would I go about doing that?
Consider putting it into its own function like below.
Public Function GetOrOpenWorkbook(ByVal sFullPath As String) As Workbook
Dim wbReturn As Workbook
On Error Resume Next
Set wbReturn = Workbooks(Dir(sFullPath))
On Error GoTo 0
If wbReturn Is Nothing Then
Set wbReturn = Workbooks.Open(sFullPath)
End If
Set GetOrOpenWorkbook = wbReturn
End Function
Sub test()
Dim wb As Workbook
Set wb = GetOrOpenWorkbook("C:\Path\Path.xlsx")
End Sub
The Dir function will return just the file name without the path. If a workbook with that name is already open, it will return that workbook. If not, it attempts to open it.
Related
I try to open a workbook of the type '.xlsm' using
Private Function readFiles(ByVal lv_path As String, ByRef lx_wrkShDes As Worksheet)
'On Error GoTo ErrorHandling
Dim lx_objectExcel As New Excel.Application
Dim lx_wrkBkSrc As Workbook
Dim lx_wrkShSrc As Worksheet
Dim lx_shrPathObj As Object
Dim lv_shrPath As String
Set lx_shrPathObj = CreateObject("scripting.filesystemobject")
lv_shrPath = Replace(lx_shrPathObj.GetFile(lv_path).ShortPath, mv_longFilePathHelper, "")
Set lx_wrkBkSrc = Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
'Using lx_objectExcel.Workbooks.Open WORKS but not Workbooks.Open
'lx_objectExcel.Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
If Not Library.DoesSheetExist(lx_wrkBkSrc, mv_workSheetName) Then
GoTo ErrorHandling
End If
Set lx_wrkShSrc = lx_wrkBkSrc.Sheets(mv_workSheetName)
'Rest of the function
End Function
It opens the workbook and exits the VBA code immediately.
I tried this https://support.microsoft.com/en-us/help/555263, but same results.
It does not exit if I use new instance of Excel using
lx_objectExcel.Workbook.open('path')
I do not want to use a new instance as paste special is not suitable with new instance and opening 100s of Workbooks this way consumes lot of time.
Replace:
Workbook.open('path')
With
Workbooks.Open("PathName")
Referring to the Workbook.Open method, the correct syntax for your action is the following
Workbooks.Open("WorkbookPath")
The following code totally works for me
Dim targetWorkbook As Workbook
Set targetWorkbook = Workbooks.Open("YourWorkbookPath")
You are not using it properly. If this still doesn't work, make sure to send the correct path for your file.
tried this code with 2 xlsm files (MASTER and SLAVE) and it works fine form me. Office 2013
Dim sText As String
Dim objWB As Excel.Workbook
sText = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
Set objWB = Application.Workbooks.Open(ThisWorkbook.Path & "\SLAVE.XLSM")
objWB.Worksheets("Sheet1").Range("A1").Value = sText
MsgBox "DONE!"
I try to open a workbook of the type '.xlsm' using
Private Function readFiles(ByVal lv_path As String, ByRef lx_wrkShDes As Worksheet)
'On Error GoTo ErrorHandling
Dim lx_objectExcel As New Excel.Application
Dim lx_wrkBkSrc As Workbook
Dim lx_wrkShSrc As Worksheet
Dim lx_shrPathObj As Object
Dim lv_shrPath As String
Set lx_shrPathObj = CreateObject("scripting.filesystemobject")
lv_shrPath = Replace(lx_shrPathObj.GetFile(lv_path).ShortPath, mv_longFilePathHelper, "")
Set lx_wrkBkSrc = Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
'Using lx_objectExcel.Workbooks.Open WORKS but not Workbooks.Open
'lx_objectExcel.Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
If Not Library.DoesSheetExist(lx_wrkBkSrc, mv_workSheetName) Then
GoTo ErrorHandling
End If
Set lx_wrkShSrc = lx_wrkBkSrc.Sheets(mv_workSheetName)
'Rest of the function
End Function
It opens the workbook and exits the VBA code immediately.
I tried this https://support.microsoft.com/en-us/help/555263, but same results.
It does not exit if I use new instance of Excel using
lx_objectExcel.Workbook.open('path')
I do not want to use a new instance as paste special is not suitable with new instance and opening 100s of Workbooks this way consumes lot of time.
Replace:
Workbook.open('path')
With
Workbooks.Open("PathName")
Referring to the Workbook.Open method, the correct syntax for your action is the following
Workbooks.Open("WorkbookPath")
The following code totally works for me
Dim targetWorkbook As Workbook
Set targetWorkbook = Workbooks.Open("YourWorkbookPath")
You are not using it properly. If this still doesn't work, make sure to send the correct path for your file.
tried this code with 2 xlsm files (MASTER and SLAVE) and it works fine form me. Office 2013
Dim sText As String
Dim objWB As Excel.Workbook
sText = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
Set objWB = Application.Workbooks.Open(ThisWorkbook.Path & "\SLAVE.XLSM")
objWB.Worksheets("Sheet1").Range("A1").Value = sText
MsgBox "DONE!"
I have some VBA script in one Excel Workbook that has three subs that each either read from a second Workbook. Each of the subs uses the following algorithm (simplified to distill the interaction with the second book):
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
If Not WorkbookIsOpen(wkbName) Then
Workbooks.Open (path)
End If
Set remoteDataSheet = Workbooks(wkbName).Sheets(source)
remoteDataSheet.Cells(1,1) = localDataSheet.Cells(1,1)
remoteDataSheet.Cells(1,2) = localDataSheet.Cells(1,2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Function WorkbookIsOpen(targetWorkbook As String) As Boolean
Dim testBook As Workbook
On Error Resume Next
Set testBook = Workbooks(targetWorkbook)
If Err.Number = 0 Then
WorkbookIsOpen = True
Else:
WorkbookIsOpen = False
End If
End Function
There is also a pivot table in this Workbook that draws its data from the second file though an external data connection as well. The issue that is plaguing me is that it seems that not initially but after a few operations, these subs stop making the edits properly and instead it opens a read only copy of the second Workbook. When I try to open the second workbook manually I get a message saying that the file is already open and is locked for editing. Right now both files are local to my computer and couldn't be opened by anyone else. What am I missing to be sure that I can make the code work as intended?
I made some modification to your code, ran it a few times, and didn't get your "Read-only" message.
In your code the line of declaring localDataSheet is missing, added Dim localDataSheet As Worksheet , also added Dim remoteWb As Workbook for the remote workbook.
(didn't modify your Funtion WorkbookIsOpen code).
Sub EditRemote Code
Option Explicit
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim localDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
Dim remoteWb As Workbook
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
' check if workbbok already open
If Not WorkbookIsOpen(wkbName) Then
Set remoteWb = Workbooks.Open(path)
Else
Set remoteWb = Workbooks(wkbName) ' workbook is open >> set remoteWb accordingly
End If
Set remoteDataSheet = remoteWb.Sheets(source)
remoteDataSheet.Cells(1, 1) = localDataSheet.Cells(1, 1)
remoteDataSheet.Cells(1, 2) = localDataSheet.Cells(1, 2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Just to verify the data in your Excel "Parameters" sheet, the screen-shot below shows the data I used for my testing.
Cell A2 contains the "Clean" workbook name.
Cell B2 contains workbbok "full" name - path + "clean" workbook name.
After some further testing to diagnose the issue, I found that there was nothing wrong with the VBA code, but rather the external data connection to the remote Workbook was locking that Workbook every time I refreshed the data in the pivot table that used the external data connection as its source. It isn't unlocking the file when it is done refreshing, and that leaves the file locked until I close the Workbook with the pivot table. Now I just need to solve that problem.
I'm trying to copy a range of values from a workbook to another by using a dialog box to select the file I'd like to copy the data from.
I'd like also not to open the "copyFrom" workbook in the process. The problem lies in passing the file path in the string "filename" to the workbook variable "copyFrom".
Option Explicit
Private Sub butt_copy_Click()
Call copy1
End Sub
Private Sub copy1()
Dim fileName As String, copyFrom As Workbook
fileName = Application.GetOpenFilename()
copyFrom = filename
Sheet1.Range("A1:A20") = copyFrom.Sheets(Sheet1).Range("A1:A20")
End Sub
Just a comment to add to the algorithm;
It opens the file and reads from it, but does not close. This makes it "READ_ONLY" for all other users!
I suggest that at the end of the code: add this for saving original file unchanged.
Application.DisplayAlerts = False
app.Workbooks.Close savechanges:=False
Application.DisplayAlerts = True
Try Below. But i have some Clarification like where will you run the code from
Application.Visible=False
Set copyFrom = Application.Workbooks.Open(fileName)
Then Try below. Worked Perfectly for me
Private Sub copy1()
Dim app As New Excel.Application
Dim fileName As String, copyFrom As Workbook
app.Visible = False
fileName = app.GetOpenFilename()
Set copyFrom = app.Workbooks.Open(fileName)
MsgBox copyFrom.Sheets(1).Cells(1, 1)
'Sheet1.Range("A1:A20") = copyFrom.Sheets(Sheet1).Range("A1:A20")
End Sub
I want to open and refer to a workbook via the function below. Only the function produces the run-time error '91': object variable or with block variable not set just before jumping back into the main code.
When I put the exact code (just not as function) into my main code it works perfectly.
But I don't want to have the whole function in my main code because I think it's unnecessary and ugly.
Maybe someone can help me make my code nicer and better comprehensible!
Thank you already!
This is the relevant part of my main sub:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
WBtest = openfile(WBpath) 'I call my function here
End Sub
This is the function that produces the error
The function is supposed to return the (newly) opened workbook
Public Function openfile(path As String) As Workbook 'path is fullpath
Dim wb As Workbook
Dim alreadyopen As Boolean
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = path Then 'check if file is already open
alreadyopen = True
Set openfile = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set openfile = Workbooks.Open(path)
End If
'MsgBox openfile.name 'this returns the right name
End Function
When I write all of it in my main sub it works (but is ugly, so I don't want it there!)
This works:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
Dim wb As Workbook 'for loop
Dim alreadyopen As Boolean
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = WBpath Then
alreadyopen = True
Set WBtest = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set WBtest = Workbooks.Open(WBpath)
End If
End Sub
I have a similar problem later in my code, where I want to have a function return a workbook, too. So this seems to be the problem.
How does a function return a workbook?
I have found similar functions returnins worksheets. Those work. Why not with workbooks?
Thank you so much for your help!
The different between both approaches is that, in the first one, you are forgetting the Set bit. Thus, solution:
Set WBtest = openfile(WBpath) 'I call my function here