I am trying to open and save a workbook based on what the use decides to name the file. I am able to open and save the workbook but I cannot figure out how to give the user the option to change the name of the save file. Here is my code:
Sub Sheets()
Dim wb1 As Workbook
wb1save = Application.InputBox("What would you like to save this file as?")
Set wb1 = Workbooks.Add
wb1.SaveAs ("e:\excel\"Filename:=wb1save")
End Sub
Any help would be greatly appreciated.
Thanks,
G
I don't see a reason to use Excel.Application.InputBox over plain old VBA.Interaction.InputBox here. The function returns a null string pointer (kind of undocumented behavior though) if the user cancels the prompt, so you should handle that.
Dim result As String
result = InputBox(prompt, default)
If StrPtr(result) = 0 Then Exit Sub
wb1.SaveAs result
But don't use an InputBox for this (whether Excel.Application.InputBox or VBA.Interaction.InputBox - neither is meant for this kind of user input). Use Application.GetSaveAsFileName instead, and get an actual "SaveAs" dialog propmt the user for a filename, and let them browse folders and not make typos.
The function returns a Boolean value (False) if the user cancels the prompt, so you should handle that.
Dim result As Variant
result = Application.GetSaveAsFileName
If VarType(result) = vbBoolean Then Exit Sub
wb1.SaveAs result
With that you're pretty much guaranteed to have a valid file/path. With InputBox, not so much.
The dialog will open on whatever the CurDir is, so you can use ChDrive and ChDir to control the default directory.
Here you go:
Sub Sheets()
Dim wb1 As Workbook
wb1save = Application.InputBox("What would you like to save this file as?")
Set wb1 = ActiveWorkbook
wb1.SaveAs ("e:\excel\" & wb1save)
End Sub
Related
Hello I am working on "Packing list Form (PL)" have a set of codes which opens a "Tracing Form", and copy whatever that is on there to "Packing list Form (PL)"
but when I run the code the second time, "Tracing Form" is already open,
so it prompts me saying
""Tracing Form" is already open. reopening will cause any changes you made to be discarded. do you want to reopen "Tracing Form"?"
I want it to say No and continue with the rest of the code !!
please help...
here's part of the code that's relevant
Set PL = Workbooks("PACKING LIST FORM").ActiveSheet
userprofile = Environ$("userprofile")
Workbooks.Open userprofile & "\Dropbox\Tissue Tracing Form"
Set tracingform = Workbooks("Tissue Tracing Form.xlsx").Worksheets("2018_1")
ActiveWindow.WindowState = xlMinimized
'execution
from_lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).row
.
.
.
.
The function below allows you to check if a workbook is already open and assign xRet a boolean value, you can then use that within a case to run the rest of your code or open the workbook and then run the rest of your code. This will avoid you trying to open the workbook when it is already open and so you wont get that pop up message.
Sub CheckExcelOpen()
Dim myPath As String
Dim xRet As Boolean
xRet = IsWorkBookOpen(Tissue Tracing Form.xlsx)
If xRet Then
'YOUR CODE WHEN ALREADY OPEN
Else
Workbooks.Open (TissueTracingFullFilePath) 'action needs the full file path to open
'YOUR CODE ONCE OPEN
End If
End Sub
The function-
Function IsWorkBookOpen(Name As String) As Boolean
Dim xWb As Workbook
On Error Resume Next
Set xWb = Application.Workbooks.Item(Name)
IsWorkBookOpen = (Not xWb Is Nothing)
End Function
I hope this helps
Ive a scenario to do some changes in a workbook in another workbook path. But the question is I need to check whether the workbook already open or not. If not I need to get that opened instance to a workbook variable.
Here is the code Im using for checking whether workbook open or not and then the code for opening
Function IsFileOpen(fileFullName As String)
Dim FileNumber As Integer
Dim errorNum As Integer
On Error Resume Next
FileNumber = FreeFile() ' Assign a free file number.
' Attempt to open the file and lock it.
Open fileFullName For Input Lock Read As #FileNumber
Close FileNumber ' Close the file.
errorNum = Err ' Assign the Error Number which occured
On Error GoTo 0 ' Turn error checking on.
' Now Check and see which error occurred and based
' on that you can decide whether file is already
' open
Select Case errorNum
' No error occurred so ErroNum is Zero (0)
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied." is 70
' File is already opened by another user.
Case 70
IsFileOpen = True
' For any other Error occurred
Case Else
Error errorNum
End Select
End Function
Public Function getConsolidatedDataFile() As Workbook
Dim p As String
p = ActiveWorkbook.Path
Dim cf As String
cf = printf("{0}\ConsolidatedData.xlsx", p)
Dim wb As Workbook
Dim fo As Boolean
fo = IsFileOpen(cf)
If fo = False Then wb = Workbooks.Open(filename:=cf)
''I need to get the code for this place of fo is true
getConsolidatedDataFile wb
End Function
So if file open I need to get that workbook in to that wb variable.
Ive got a solution
If fo = False Then
Set wb = Workbooks.Open(filename:=cf)
Else
Dim w As Workbook
For Each w In Workbooks
If w.FullName = cf Then
Set wb = w
End If
Next
End If
Here is in the loop its traversing through all workbook and if its there take that reference..
I hope this help
Dim dict As Dictionary
Function OpenFile(fileFullName As String) As Workbook
If (dict.Exists(fileFullName)) Then
OpenFile = dict.Item(fileFullName)
End If
dict.Add "fileFullName", Workbooks.Open(Filename:=fileFullName)
OpenFile = dict.Item(fileFullName)
End Function
Application.ActiveWorkbook = OpenFile(fileFullName)
To reference a workbook to the workbook collection it should be opened -
The Workbook object is a member of the Workbooks collection. The Workbooks collection contains all the Workbook objects currently open in Microsoft Excel.
MSDN Wrokbook Object
Thus, if your workbook is in the same Excel instance, then try like this:
Public Sub TestMe()
Dim wb As Workbook
Set wb = Workbooks("12.xlsx")
End Sub
If it is not in the same instance, then GetObject should work:
Public Sub TestMe()
Dim wb As Workbook
Set wb = GetObject("C:\path\12.xlsx")
Debug.Print wb.Worksheets(1).Name
End Sub
GetObject MSDN
This is how 3 workbooks in the same instance look like:
This is how 2 workbooks look like in 2 different instances:
Pros and Cons for using multiple instances (Source answers.microsoft.com):
Pros
If you have 32-bit Excel, each instance can use up to 3 GB memory. If you have a powerful computer, very heavy files, and 32-bit Excel, each instance of Excel can use 3 GB. So with e.g. 2 instances of Excel.exe, you could say that the total memory Excel could use triples. (Please note that this is not needed with 64-bit Excel as it is not limited by 3 GB memory per instance)
If you want to have a separate Undo chain, so that each Undo only undos in the currently active workbook, then separate instances will indeed achieve this.
Cons
If you want to have a common Undo chain shared by all open files, then using multiple instances will not achieve this.
If you want to be able to e.g. press Ctrl+F6 to jump between your open files quickly, then using multiple instances will not achieve this.
Paste Special will not work between instances. See this for more info.
Making workbook links between 2 files in separate running instances cannot be made by clicking, and will not update in real-time.
The code looks ok, simply use the Set keyword:
If fo = False Then set wb = Workbooks.Open(filename:=cf)
Here is a quick function that will open the workbook if it's not already open:
Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
On Error GoTo 0
End Function
I have a list of excel files in a spreadsheet. I'd like to loop through them and add a worksheet event to each. Save it, close it and move on to the next. The problem is that when I reopen (manually) the workbook the code is gone.
Inside the for each loop:
Set xl = Workbooks.Open(filepath)
addCode xl 'subroutine to add code
xl.Save
xl.Close SaveChanges:=False
The addCode subroutine is:
Sub addCode(book As Excel.Workbook)
acsh = book.ActiveSheet.CodeName
startline = book.VBProject.VBComponents(acsh).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1
book.VBProject.VBComponents(acsh).CodeModule.InsertLines startline, codetoadd
End Sub
If I comment out xl.Close the code is in the workbook and works. I can manually save and close the file and the code remains. I've added a break point between xl.save and xl.close and made a copy of the file. After the code is done neither has the changes. I've tried using xl.saveas and xl.close SaveChanges:=True. All have identical results.
I'm using Excel 2013, I've told excel to trust access to the VBA object model. I've tried using XLS files and XLSM files. Obviously XLSX won't work.
Here is some sample code which is working for me on Excel 2010. The changes I made to your example code are:
use a .xlsm for the target workbook - I know you said you already did that.
reference a specific worksheet in the AddCode sub rather than pick up the sheet name from ActiveSheet.
set the workbook dirty status per Ralph's comment
Don't set the SaveChanges flag when closing the target workbook
Other than that, my version is pretty similar to yours. I think it is the wb.Saved = False line that does the trick i.e. the dirty flag. I tried to use the SaveAs method on the VBProject itself thinking it would be the same as hitting the save button when you are in the VBA Editor itself. However, this just gives unhelpful errors.
Here's the sample code:
Option Explicit
Sub Test()
Dim wbTarget As Workbook
Dim strCode As String
' get target workbook
Set wbTarget = Workbooks.Open("\\server\path\Book3.xlsm")
' test setting code to worksheet change
strCode = "Debug.Print ""Sheet selection changed to: "" & Target.Address"
AddWorksheetChangeCode wbTarget, "Sheet1", strCode
' test saving the target workbook
With wbTarget
' set book to dirty to force the save
.Saved = False
.Save
.Close
End With
End Sub
Sub AddWorksheetChangeCode(ByRef wb As Workbook, strWorksheetName As String, strCode As String)
Dim intInsertLine As Integer
' create stub for event and get line to insert
intInsertLine = wb.VBProject.VBComponents(strWorksheetName).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1
' add event logic
wb.VBProject.VBComponents(strWorksheetName).CodeModule.InsertLines intInsertLine, strCode
End Sub
I've made a macro to open two workbooks and do some stuff with them. This macro runs from a third workbook that calls any other two user selected workbooks for which, before they're opened, I don't know their name.
So! I know Excel 2010 doesn't have a built in function to check if a workbook is open so, I've been trying to compare the workbook against Nothing but it doesn't work and every workaround I find in different sites tend to use the name of the workbook.
Is there another way of doing this?
The idea is to run a macro with the two user defined workbooks and then, maybe, re-running it in the same workbooks but Excel warms me of discarding changes.
Maybe a workaround could be to tell excel when it prompts for reopening, not to reopen and handle that error to just use the same workbooks, for which at least, I know how part or the names will be. For example, one will have the text "cluster" in it, and the other the word "translation" so, maybe in a loop like the next one, I could find and use the workbook I need but just If I already checked if it's open. Or, does this way works to see if it's opened already?
For each wbk in Application.Workbooks
If wbk.Name Like "*cluster*" Then
WorkingWorkbook = wbk.Name
End If
next
My code is as follows:
Sub structure()
Application.ScreenUpdating = False
Dim translationWorkbook As Worksheet
Dim clusterWorkbook As Workbook
If Not clusterWorkbook Is Nothing Then
Set clusterWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E5").Value2)
Else
Set clusterWorkbook = Application.Workbooks(parseFilePath(ThisWorkbook.Sheets(1).Range("E5")))
End If
Set translationWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E6").Value2).Worksheets("String_IDs_Cluster") 'Translation table target for completing
End Sub
The parameter passed to Workbooks.Open is the one written in the sheet by my next function:
Private Sub MS_Select_Click()
Dim File As Variant
Dim Filt As String
Filt = "Excel 97-2003 File(*.xls), *.xls," & "Excel File(*.xlsx),*.xlsx," & "Excel Macro File (*.xlsm),*.xlsm"
File = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=2, Title:="Select Menu Structure File")
If File = False Or File = "" Then
MsgBox "No File Selected"
Exit Sub
End If
ThisWorkbook.ActiveSheet.Range("E5").Value2 = File
End Sub
Same for translationWorkbook but in a different cell and also, I was trying to create a function to parse and use the filename in a full path(Then I discovered the command Dir lol) but when I pass the filename, without the xls extension to Application.Workbooks(file) it sends me a "subscript range error". Why could that be?
Basically my questions are:
How can I check for an open workbook and use it? Either by handling the
error for excel's prompt or by not trying to reopen the same file.
Why does trying to open a workbook with Application.Workbooks() with the return of my function fails? And here my question splits in two... First: with my function, wouldn't it work if I give a string as an argument? Or maybe, before passing it as an argument, I need to assign the result of my function to a variable?
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another "subscript error" but, before I used the File Dialog prompt, I made it this way and worked fine.
Any help will be appreciated.
EDIT
Function ParseFilePath added:
Function parseFilePath(fullpath As Range) As String
Dim found As Boolean
Dim contStart As Integer
Dim contEnd As Integer
contEnd = InStr(fullpath, ".") - 1
contStart = contEnd
found = False
Do While found = False
If fullpath.Characters(contStart, 1).Text = "\" Then
found = True
Else
contStart = contStart - 1
End If
Loop
parseFilePath = fullpath.Characters(contStart + 1, (contEnd - contStart)).Text
End Function
How can I check for an open workbook and use it? Either by handling the error for excel's prompt or by not trying to reopen the same file.
Have done some small modifications to your procedure structure. Similar to what you were trying testing for the workbook variable to be nothing, only that you have to first attempt to set the variable, the way you were doing it will always return empty as you did not try to set it before. I have also tested for the translation workbook, as it mightt be open as well.
I'm assuming the values in E5 and E6 contain the FullName of the workbook (i.e. path + filename) and that parseFilePath is a function to extract the filename from the FullName.
Sub structure()
Application.ScreenUpdating = False
Dim clusterWorkbook As Workbook
Dim translationWorkbook As Workbook
Dim translationWorksheet As Worksheet
With ThisWorkbook.Sheets(1)
On Error Resume Next
Set clusterWorkbook = Application.Workbooks(parseFilePath(.Range("E5").Value2))
On Error GoTo 0
If clusterWorkbook Is Nothing Then Set clusterWorkbook = Application.Workbooks.Open(.Range("E5").Value2)
'Set Translation table target for completing
On Error Resume Next
Set translationWorkbook = Application.Workbooks(parseFilePath(.Range("E6").Value2))
On Error GoTo 0
If translationWorkbook Is Nothing Then
Set translationWorksheet = Application.Workbooks.Open(.Range("E6").Value2).Sheets("String_IDs_Cluster")
Else
Set translationWorksheet = translationWorkbook.Sheets("String_IDs_Cluster")
End If
End With
End Sub
Why does trying to open a workbook with Application.Workbooks() with
the return of my function fails? And here my question splits in two...
First: with my function, wouldn't it work if I give a string as an
argument? Or maybe, before passing it as an argument, I need to assign
the result of my function to a variable?
Not sure why it did not work, change the prodedure as indicated.
I tested the procedure above using this function to extract the Filename from the Fullname and it worked:
Function parseFilePath(sFullName As String) As String
parseFilePath = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\"))
End Function
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another
"subscript error" but, before I used the File Dialog prompt, I made it
this way and worked fine.
Bear in mind that you did not used that line alone, it most probably has something like:
set Workbook = Application.Workbooks("clusterworkbook")
So the command was to set a variable, not to open the workbook, as such the only situation in which this works is that the workbook is already open so the variable gets set. The times when it failed was when the workbook was not open and you tried to set the variable, given you an error.
Suggest to visit these pages
Excel Objects, On Error Statement
I have been using the below code to identify if the excel workbook is open. If yes, then i activate it and do some stuff. If not, i open it and do some stuff.
sub test()
Dim Ret
Ret = IsWorkBookOpen("Your excel workbook full path")
If Ret = False Then
Workbooks.Open FileName:="Your excel workbook full path", UpdateLinks:=False
Else
Workbooks("Workbook name").Activate
End If
end sub
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
I need to write a macro in VBA that will open every file in a given directory one by one and run a macro on them.
so far i have something like
for i = 1 to number_of_files
open Dir("C:\yourPath\*.*", vbNormal)
call some_macro
close file
next i
By calling the Dir() function with an appropriate filter, such as "c:\folder\*.xls", you start enumeration and get the first file name.
After that, repeatedly calling the Dir() function without any parameters, you will get all *.xls file names, one for each call.
You open a workbook by calling Workbooks.Open(full_path). This gives you a Workbook object, against which you can run a macro.
The .Close() method of this Workbook object closes the workbook. You can use .Close(SaveChanges:=True) to save changes, .Close(SaveChanges:=False) to discard changes, or omit the parameter to have the user decide.
Here's the easy VBA object way to do it:
Dim fs As FileSearch
Dim i As Integer
Dim wbk As Workbook
Set fs = Application.FileSearch
With fs
.LookIn = ThisWorkbook.Path
.FileName = "*.xls"
For i = 1 to .Execute()
Set wbk = Workbooks.Open(.FoundFiles(i))
''//RUN MACRO HERE
wbk.Close(SaveChanges:=True)
Next i
End With