I am trying to open a file from somewhere and also get the date when the opened file was created. However the line below gives me an error "Run Time Error, Automation error and Unspecified error". How can I fix this? Thanks.
MsgBox wb2.BuiltinDocumentProperties("Creation Date")
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1, Ret2
Dim WS As Worksheet
Set wb1 = ActiveWorkbook
'Clear Summary tab
wb1.Worksheets("Summary").Cells.Clear
'Delete existing worksheet with name "Task List Data Export"
For Each WS In Worksheets
If WS.Name = "Task List Data Export" Then
Application.DisplayAlerts = False
Sheets("Task List Data Export").Delete
Application.DisplayAlerts = True
End
End If
Next
'Get the File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
'Copy file
Set wb2 = Workbooks.Open(Ret1)
MsgBox wb2.BuiltinDocumentProperties("Creation Date")
wb2.Sheets(1).Select
wb2.Sheets(1).Copy After:=wb1.Sheets(2)
'Close opened file
wb2.Close savechanges:=False
Set wb2 = Nothing
Worksheets("Cover").Activate
End Sub
If Microsoft Excel doesn’t define a value for one of the built-in document properties, reading the Value property for that document property causes an error.
From Workbook.BuiltinDocumentProperties Property
There is always a file created date and hence it is quite surprising that you are getting that error. I have never got this error. Even a newly created file which has not been saved gives you a "File Created Date and Time".
Here is an alternative.
Dim CtdDate As String
Dim fs As Object, f As Object
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(Ret1)
CtdDate = f.DateCreated
Set wb2 = Workbooks.Open(Ret1)
MsgBox CtdDate
Related
I am trying to create a code to open an Excel file (CSV file actually) in the active worksheet of a workbook. The file is not always located on the same location and does not always have the same name. Therefore I want the user to be able to browse the file.
I tried the code shown below. The code works partially, the code now opens the file in a new workbook. However, I would like to open the file/get the data in the active worksheet. Do you know how I could change the code to do this?
Sub OpenFile()
Dim FileName As String, test As Workbook
On Error GoTo ErrorMessage
FileName = Application.GetOpenFilename(, , "Browse for workbook")
'Open workbook
Workbooks.Open FileName
Set test = ActiveWorkbook
Exit Sub
ErrorMessage:
MsgBox ("Je hebt geen bestand geselecteerd, probeer het nogmaals.")
End Sub
You could just open the file copy the cells to the target worksheet.
Sub OpenFile()
Dim FileName As String
FileName = Application.GetOpenFilename("Comma Separated Values,*.csv", , "Browse for workbook")
If FileName = "False" Then Exit Sub
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ActiveSheet
Application.ScreenUpdating = False
With Workbooks.Open(FileName)
ActiveSheet.UsedRange.Copy TargetWorksheet.Range("A1")
.Close SaveChanges:=False
End With
End Sub
You could open the workbook the user selects and copy whatever sheet you need into your current workbook. Edit: This will paste it into your active sheet using UsedRange as others have shown.
Sub OpenFile()
Application.ScreenUpdating = False
Dim FileName As String, test As Workbook
Dim shActive As Worksheet
On Error GoTo ErrorMessage
FileName = Application.GetOpenFilename(, , "Browse for workbook")
'Open workbook
Set shActive = ActiveSheet
Set test = Workbooks.Open(FileName)
'copy the sheet you need from that workbook into your current workbook
test.Sheets(1).UsedRange.Copy shActive.Range("A1")
'close the previous workbook
test.Close SaveChanges:=False
Exit Sub
ErrorMessage:
MsgBox ("Je hebt geen bestand geselecteerd, probeer het nogmaals.")
End Sub
I am trying to automatically save a .xls file in a hardcoded location, in the .xlsx file format. I want the SaveAs dialog to be showing the hardcoded location, and the file name that has been coded in the "File Name:" field . This is so that all I need to do is click on the Save button.
However, the SaveAs dialog always end up showing C Drive, when I want to save my file in the H Drive.
The following are my codes:
Option Explicit
Sub externalRatingChangeFile()
'Declare the data type of the variables
Dim wks As Worksheet
Dim sFilename As String
'Set wks to the current active worksheet
Set wks = ActiveWorkbook.ActiveSheet
'Set the location to save the file to a variable
sFilename = "H:\testing file"
'Save as .xlsx file in the specific location stated earlier
'If there are errors in the code, set wks to nothing and end the process
On Error GoTo err_handler
ChDrive sFilename
ChDir sFilename
Application.Dialogs(xlDialogSaveAs).Show (sFilename & "\TestingFile - " & Format(Date, "YYYYMMDD") & ".xlsx")
'System to/not display alerts to notify Users that they are replacing an existing file.
Application.DisplayAlerts = True
err_handler:
'Set Wks to its default value
Set wks = Nothing
End Sub
Instead of showing the Save As Dialog box, just save directly to the folder.
Application.DisplayAlerts = False
wks.SaveAs (sFilename + "\TestingFile - " + Format(Date, "YYYYMMDD") + ".xlsx")
Application.DisplayAlerts = True
or
Application.DisplayAlerts = False
wks.SaveCopyAs (sFilename + "\TestingFile - " + Format(Date, "YYYYMMDD") + ".xlsx")
Application.DisplayAlerts = True
Lastly you could create your own Dialog Box to make sure you are saving in the correct location:
'Result = 2 is Cancel
'Result = 1 is Ok
result = MsgBox("Would You Like To Save in the Following Location: " + "H:\Test File....", vbOKCancel, "Save As")
While I prefer the Application.GetSaveAsFilename method (see this), setting the initial folder on a xlDialogSaveAs should be no problem providing that the original workbook has not been previously saved.
Sub externalRatingChangeFile()
Dim bSaved As Boolean
Dim xlsxFileFormat As XlFileFormat
'Declare the data type of the variables
Dim wks As Worksheet
Dim sFilename As String
'Set wks to the current active worksheet
Set wks = ActiveWorkbook.ActiveSheet
'Set the location to save the file to a variable
sFilename = "H:\testing file"
xlsxFileFormat = XlFileFormat.xlOpenXMLWorkbook
'Save as .xlsx file in the specific location stated earlier
On Error GoTo err_handler
bSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=sFilename & "\TestingFile - " & Format(Date, "YYYYMMDD"), _
arg2:=xlsxFileFormat)
'System to/not display alerts to notify Users that they are replacing an existing file.
Application.DisplayAlerts = True
err_handler:
'Set Wks to its default value
Set wks = Nothing
End Sub
I have a Book1.xls Excel workbook which has a macro written so that on workbook open the macro runs.
This macro takes all the CSV files in the workbook path and merges all the CSV into a single sheet say Master.xlsx which works fine and creates the Master.xlsx.
At the end of this macro I am calling another macro written in a module of same sheet and passing the Master.xlsx reference as workbook argument to another macro
Now what I want is that I need to set Master.xlsx passed an argument to this macro(module) as the current/active workbook so that I can format contents of the master.xlsx
My Code for the Book1.xls is :
Private Sub Workbook_Open()
'Create Excel application instance
Dim xlApp As Object
Dim dt, masterpath, folderPath, fileName, dtFolder As String
Set xlApp = CreateObject("Excel.Application")
'Setup workbooks
Dim wb As Excel.Workbook
Dim wBM As Excel.Workbook
Dim Wk As Workbook
fileName = "C:\Master.xlsx"
'Create a new Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs fileName:=fileName
Wk.Close SaveChanges:=False
Application.DisplayAlerts = True
'Csv files folder
Dim CSVfolder As String
CSVfolder = masterpath
'Master Excel file path
Dim mF As String
mF = fileName 'Where your master file is
'open the master file
Set wBM = xlApp.Workbooks.Open(mF)
'search and open the client files
Dim fname As String
fname = Dir(CSVfolder & "\*.csv")
Do While fname <> ""
'open the client file
Set wb = xlApp.Workbooks.Open(CSVfolder & "\" & fname)
'copy the first sheet from client file to master file
wb.Sheets(1).Copy After:=wBM.Sheets(wBM.Sheets.count)
'save master file
wBM.Save
'close client file
wb.Close False
'move to next client file
fname = Dir()
Loop
xlApp.Visible = True
Set xlApp = Nothing
Call AnotherMacroInModuleOfSameWorkbook(wBM)
End Sub
Code for Macro in Module of same Workbook
Sub AnotherMacroInModuleOfSameWorkbook(wb As Workbook)
wb.Activate
MsgBox (wb.Name)
MsgBox (ActiveWorkbook.Name)
End Sub
Here I'm getting "Master.xlsx" for alert 1 and "Book1.xls" for alert 2
What I wanted was that since I am passing reference of the Master.xlsx from the above macro and then activating the Master.xlsx in the below macro, the alert 2 should have given "Master.xlsx" as alert.
Please help.
Thanks.
By changing this line, the Master sheet opens now, where it wasn't before. It was just accessing it. I tested using my own workbooks, and used your code as a base. However, I didn't use all of your code, being that I don't have those objects. So it's mostly tested. I did generate the same errors you got before solving with this line, so I'm very certain this solves your problem:
Set wBM = Application.Workbooks.Open(mF)
The problem there is that when you open it, the code will break and need to be continued. To solve that, you need to place the following line before opening the workbook.
Application.EnableCancelKey = xlDisabled
BE WARNED: If you do this, you will not be able to break your code if you generate an infinite loop.
Please see this article about how to deal with EnableCancelKey
You are also trying to open a .xlsx file, instead of .xlsm Include this with your file creation statements.
FileFormat:= _xlOpenXMLWorkbookMacroEnabled
I found an workaround for this issue.
I tried closing the Master file generated (wBM) and again open the master workbook using Workbooks(mF).Open which ultimately gave me the current workbook (Master) as Active workbook.
Phewww..!!!! Hard time
Here's snapshot of the current working code:
Private Sub Workbook_Open()
'Create Excel application instance
Dim xlApp As Object
Dim dt, masterpath, folderPath, fileName, dtFolder As String
Set xlApp = CreateObject("Excel.Application")
'Setup workbooks
Dim wb As Excel.Workbook
Dim wBM As Excel.Workbook
Dim Wk As Workbook
fileName = "C:\Master.xlsx"
'Create a new Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs fileName:=fileName
Wk.Close SaveChanges:=False
Application.DisplayAlerts = True
'Csv files folder
Dim CSVfolder As String
CSVfolder = masterpath
'Master Excel file path
Dim mF As String
mF = fileName 'Where your master file is
'open the master file
Set wBM = xlApp.Workbooks.Open(mF)
'search and open the client files
Dim fname As String
fname = Dir(CSVfolder & "\*.csv")
Do While fname <> ""
'open the client file
Set wb = xlApp.Workbooks.Open(CSVfolder & "\" & fname)
'copy the first sheet from client file to master file
wb.Sheets(1).Copy After:=wBM.Sheets(wBM.Sheets.count)
'save master file
wBM.Save
'close client file
wb.Close False
'move to next client file
fname = Dir()
Loop
'close the current workbook
wBM.Close False
xlApp.Visible = True
Set xlApp = Nothing
'setting the reference again
Set newfile = Workbooks.Open(mF)
MsgBox (newfile.Name)
MsgBox (ActiveWorkbook.Name)
'Call to another module
Call AnotherMacroInModuleOfSameWorkbook(wBM)
End Sub
These two lines did the trick:
'close the current workbook
wBM.Close False
'setting the reference again
Set newfile = Workbooks.Open(mF)
Thanks for all the answers.
I have a VB form in Access 2010, that opens a file dialog box to make a excel selection. I send the file path as string to my variable: directory (directory = strPath) to open the workbook and copy its contents to my current workbook. Which works fine if you intend to use the tool once. It's when you import one file, then another that's in the same directory the error occurs.
Non-working Example:
Selected C:\Desktop\File1.xls, Import
Selected C:\Desktop\File2.xls, Import
Error:
Run-time error '1004':
A document with the name 'Tool.xlsm' is already open. You cannot open two documents with the same name, even if the documents are in different folders. To open the second document, either close the document that's currently open, or rename one of the documents.
Working Example (Separate Folders):
Selected C:\Desktop\File1.xls, Import
Selected C:\Desktop\TestFolder\File2.xls, Import
Public Sub CommandButton1_Click()
Dim intChoice As Integer
Dim strPath As String
Application.EnableCancelKey = xlDisabled
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
'print the file path to sheet 1
TextBox1 = strPath
End If
End Sub
Public Sub CommandButton2_Click()
Dim directory As String, FileName As String, sheet As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = strPath
FileName = Dir(directory & "*.xls")
Do While FileName <> ""
Workbooks.Open (directory & FileName)
For Each sheet In Workbooks(FileName).Worksheets
total = Workbooks("Tool.xlsm").Worksheets.Count
Workbooks(FileName).Worksheets(sheet.name).Copy _
after:=Workbooks("Tool.xlsm").Worksheets(total)
Next sheet
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlDisabled
Application.DisplayAlerts = False
End Sub
In DEBUG mode it doesn't like
Workbooks.Open (directory & FileName)
Any suggestions on a way to eliminate this error?
First, between directory and FileName, i assume there is a "\".
secondly, simply check if the workbook is already opened:
dim wb as workbook
err.clear
on error resume next
set wb = Workbooks (FileName) 'assuming the "\" is not in FileName
if err<>0 or Wb is nothing then 'either one works , you dont need to test both
err.clear
set wb= Workbooks.Open (directory & FileName)
end if
on error goto 0
if you don't use application.enableevents=false, your opened Wb will trigger its workbook_open events !
I wanted to post the working code, maybe it will help someone in the future. Thanks again to those who left comments.
This code will open a file dialog, allow the user to select 1 excel file then copy all sheets from the selected file into the current workbook.
Public Sub CommandButton1_Click()
Dim intChoice As Integer
Application.EnableCancelKey = xlDisabled
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
'print the file path to textbox1
TextBox1 = strPath
End If
End Sub
Public Sub CommandButton2_Click()
Dim directory As String, FileName As String, sheet As Worksheet, total As Integer
Dim wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Err.Clear
On Error Resume Next
Set wb = Workbooks(FileName) 'assuming the "\" is not in FileName
If Err <> 0 Or wb Is Nothing Then 'either one works , you dont need to test both
Err.Clear
Set wb = Workbooks.Open(directory & TextBox1)
End If
On Error GoTo 0
FileName = Dir(directory & TextBox1)
Do While FileName <> ""
Workbooks.Open (directory & TextBox1)
For Each sheet In Workbooks(FileName).Worksheets
total = Workbooks("NAMEOFYOURWORKBOOK.xlsm").Worksheets.Count
Workbooks(FileName).Worksheets(sheet.name).Copy _
after:=Workbooks("NAMEOFYOURWORKBOOK.xlsm").Worksheets(total)
Next sheet
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableCancelKey = xlDisabled
Application.DisplayAlerts = False
End Sub
I need to import a worksheet from one excel workbook (worksheet name is not always the same) and import it into the current active workbook.
Here is what I have so far:
Sub openFile_Click()
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
wb2 = Workbooks(FileToOpen) 'This is where I am stuck..I can't give it a static name
For Each Sheet In wb1.Sheets
If Sheets.Visible = True Then
Sheets.Copy After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next Sheet
End If
This code will work for what you want you want. I made the following corrections.
Move all declarations of variables to beginning of procedure so they are declared before you use them. It is just good practice.
Assign your Active Workbook to the variable before you open the second workbook so there is only one workbook open.
Your for each statement had a few corrections as well.
Sub openFile_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
If Sheet.Visible = True Then
Sheet.Copy After:=wb1.Sheets(wb1.Sheets.Count)
End If
Next Sheet
End If
End Sub
Set the Workbook on open, (or set the workbook later without the filepath)
Here you go:
Sub openFile_Click()
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.rpt (*.rpt),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open(FileToOpen)
For Each Sheet In wb1.Sheets
If Sheet.Visible = True Then
Sheets.Copy After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next Sheet
End If
End Sub