How to name a new Excel workbook automatically in VBA - vba

I would like to create a New workbook and name it as today's date and DE.
(Eg : 22.01.2018-DE)
Format(Date, "dd/mm/yyyy") & "-DE"
If the workbook is already existed or opened, then delete it or close it. Finally save the workbook. I used the code below but not working. Displaying object defined error. Help me
I need to rename Land-DE to 22.01.2018-DE.
Sub createlandDE()
Dim wb As Workbook
Set wb = Workbooks.add
ActiveWorkbook.Names.add Name:=Format(Date, "dd/mm/yyyy") & "-DE"
Dim path As String
Dim FSO As Object
path = "Q:\Job\Land-DE.xlsx" 'Need to rename the file here
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(path) Then
On Error Resume Next
Workbooks("Land-DE").Close False 'Workbook name must automatically come here
Kill path
wb.SaveAs path
Else
wb.SaveAs path
End If

How about this:
Sub createlandDE()
Dim wb As Workbook
Set wb = Workbooks.Add
NameValue = Format(Date, "dd-mm-yyyy") & "-DE"
Dim path As String
Dim FSO As Object
delpath = "Q:\Job\Land-DE.xlsx" 'Need to name the file to delete
path = "Q:\Job\" & NameValue & ".xlsx" 'Need to rename the file here
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(path) Then
On Error Resume Next
Workbooks(NameValue).Close False
Kill delpath
wb.SaveAs path
Else
wb.SaveAs path
End If
End Sub

Try with saving as:
Workbooks("Land-DE").SaveAs Filename:="Q:\Job\22.01.2018.xlsx"
Then delete the file with the old name.
To make it look better, consider saving "Q:\Job\22.01.2018.xlsx" as a String variable.

I believe you are editing the wrong property.
I would simply use ActiveWorkbook.Name = [your desired name]

Related

Deleting and creating a new workbook with the same name

I would like to create a new Workbook with the name 'Land-DE'. If the file already exists in the directory it must delete it automatically before creating a new one. I've tried using the following code but it is not working.
Sub createwb()
Workbooks.add
Dim FSO
Dim path As String
Set FSO = CreateObject("Scripting.FileSystemObject")
set path = "D:\Job\Land-DE.xlsx"
If FSO.FileExists(path) Then
FSO.DeleteFile path, True
else
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsX"
End If
End Sub
Why must it be deleted before save? Would it be enough:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsx"
Application.DisplayAlerts = True
Have a look at the following. This will check if there is a file with the name defined in path and if so delete it before saving it again.
Sub Createwb()
Dim path As String
path = "D:\Job\Land-DE.xlsx"
If Dir(path) <> "" Then Kill path
ActiveWorkbook.SaveAs path
End Sub
Sub createwb()
Workbooks.Add
Dim FSO
Dim path As String
Set FSO = CreateObject("Scripting.FileSystemObject")
path = "D:\Job\Land-DE.xlsx"
If FSO.FileExists(path) Then
FSO.DeleteFile path, True
End If
ActiveWorkbook.SaveAs path
End Sub
Two things: Set is used for setting objects. The path there is just a string variable. Objects are a group of functions and variables, like that FSO object you create above it.
Next, you need to make sure you save after you delete it, and also that the last version of the save is not still open when you loop through again. If it is, you'll get permission denied for trying to save over a file that's currently open.
There are multiple problems with your code
set path = "D:\Job\Land-DE.xlsx" 'It is syntax error, you can only set object in VBA , string is not considered as object
FSO.DeleteFile path, True 'USE kill instead, better performance
ActiveWorkbook.SaveAs "D:\Job\Land-DE.xlsX" ' Do not user active keyword, always set the object
Here is the code :
Sub createwb()
Dim wbnew As Workbook
Set wbnew = Workbooks.Add
Dim path As String
path = "D:\Job\Land-DE.xlsx"
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(path) Then
On Error Resume Next
Workbooks("Land-DE").Close False ' Close the workbook if open
Kill path
wbnew.SaveAs path
Else
wbnew.SaveAs path
End If
End Sub

Editing multiple excel files which are in different folders all united in one folder

I have 200 folders all with different names in a folder. Now, each folder with a different name has a macro excel file (.xlsm). I'm trying to edit all the files at once with a separate file. The code goes like this:
Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "*.xlsm")
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName , ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
ws.Range("A1").Interior.ColorIndex = 0
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
But this doesn't work. I have tried tweaking it but whatever i do either does nothing or causes an error. Can someone please help me get this code to work.
(also: "testing main folder" is the folder on my desktop which holds the 200 other folders which hold the .xlsm files.)
Put Option Explicit at the top of the module. You'll get some compiler errors, one of them being that strFileName isn't declared. This would have been a great clue as to where to look, because the problem is that you're using two variable names that have roughly the same meaning when you read them, and they're getting mixed up.
After you're done fixing the variables, take a look at the documentation for the Dir function. The second issue is that you're also calling Dir multiple times in the loop, which means that you're skipping results.
It should look something more like this:
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim file As String
'path never changes, so make it a Const
Const path = "C:\Users\generaluser\Desktop\testing main folder\"
'This returns the first result.
file = Dir$(path & "*.xlsm")
Do While file <> vbNullString
Set wb = Workbooks.Open(Filename:=path & file, ReadOnly:=False)
Set ws = Application.Worksheets(1)
'Do whatever
wb.Close SaveChanges:=True
'This returns the next result, or vbNullString if none.
file = Dir$
Loop

Clear copy of current file from data

There is workflow to fill in a sheet and mail it when you're done. The method to mail will send the current sheet as attachment, but it should directly create a new copy of the sheet where all your data is removed from.
I can clear the current sheet, but that's wrong, as I need to clear the new sheet. I have read about running macros on other workbooks, but it fails to run the macro. What's the best solution?
Sub SendData_Click()
If MsgBox("Sure to send?", vbYesNo, "Confirm") = vbYes Then
' Save current sheet
ActiveWorkbook.Save
' Send the current file
Mail_ActiveSheet
' Mark this sheet as sent
Worksheets("Data").Range("B6").Value = True
' Create a new emptied version
Create_New_Copy
MsgBox "Your data is sent"
End If
End Sub
Sub Create_New_Copy()
Dim Wb As Workbook
Dim NewFileName As String
Dim FileExtStr As String
Dim FilePath As String
Set Wb = ActiveWorkbook
NewFileName = "FileNameHere " & Format(DateAdd("d", 1, Now), "yyyy-mm-dd")
FileExtStr = "." & LCase(Right(Wb.Name, Len(Wb.Name) - InStrRev(Wb.Name, ".", , 1)))
FilePath = ActiveWorkbook.Path & "\" & NewFileName & FileExtStr
' # This is the problem, how to clear only the new file??
' Clear_Sheet_Invoices
' Save this sheet as the new file
Wb.SaveCopyAs FilePath
End Sub
Sub Clear_Sheet_Invoices()
Dim Ws As Worksheet
Set Ws = Worksheets("MyDataSheet")
' Remove all contents
Ws.Range("B2:F999").ClearContents
' Mark the "sent" flag for the new sheet to False
Worksheets("Data").Range("B6").Value = False
End Sub
As you might note, I am using ActiveWorkbook.SaveCopyAs to create a copy, and I have a Sub Clear_Sheet_Invoices which can clear all required data. How to run this sub on the new file?
I have thought to copy the MyDataSheet to a new sheet, clear the data sheet, save the new file and copy the sheet back. On opening a file, I check if a copy of the sheet is present and I will remove the sheet. Yeah, damn ugly, there should be a better way right? ;)
You can change the definition of Clear_Sheet_Invoices() in that way that it requires a parameter of Workbook type and it would clear worksheet "MyDataSheet" in this workbook.
Then you can invoke this sub and pass the newly created workbook as a parameter.
Below is the code you need to change to implement it:
Sub Clear_Sheet_Invoices(Wb As Workbook)
Dim Ws As Worksheet
Set Ws = Wb.Worksheets("MyDataSheet")
' Remove all contents
Ws.Range("B2:F999").ClearContents
' Mark the "sent" flag for the new sheet to False
Wb.Worksheets("Data").Range("B6").Value = False
End Sub
Sub Create_New_Copy()
Dim Wb As Workbook
Dim NewWb As Workbook
Dim NewFileName As String
Dim FileExtStr As String
Dim FilePath As String
Set Wb = ActiveWorkbook
NewFileName = "FileNameHere " & Format(DateAdd("d", 1, Now), "yyyy-mm-dd")
FileExtStr = "." & LCase(Right(Wb.Name, Len(Wb.Name) - InStrRev(Wb.Name, ".", , 1)))
FilePath = ActiveWorkbook.Path & "\" & NewFileName & FileExtStr
' Save this sheet as the new file
Wb.SaveCopyAs FilePath
Set NewWb = Excel.Workbooks.Open(FilePath)
' # This is the problem, how to clear only the new file??
Call Clear_Sheet_Invoices(NewWb)
Call NewWb.Close(True)
End Sub
Method SendData_Click doesn't require any changes.

copy information to an external workbook

I am writing a macro where I take data from a CSV and copy it to another Excel file (not the current or active file).
What is the code to take the copied data and send it to another file in the same directory.
This is my code, I have commented out the lines that cause the macro not to work. I want to set the variable wshT to Sheet1 of the WTF.xlsx file, which is in the same directory but not the active workbook. I have not opened that one. So the goal is to use this macro to copy extra data from the CSV and send it to the WTF.xlsx file and save it as something new, in this case "BBB". Any help is much appreciated. When I uncomment those lines, errors pop up.
Sub Import()
Dim MyPath As String
Dim strFileName As String
'Dim strFileName1 As String
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
'strFileName1 = Workbooks("WTF.xlsx").Activate
'strFileName1 = Workbooks("WTF.xlsx").Worksheets("Sheet1").Select
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim wshT As Worksheet
'Set wshT = strFileName1
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.Range("A1:A3").EntireRow.Delete
'wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyPath & "\BBB", FileFormat _
:=51, CreateBackup:=False
Application.DisplayAlerts = False
'ActiveWindow.Close
End Sub
Your use of value assignment to strFileName1 through the use of .Activate and/or .Select was bad methodology. If WTF.xlsx is open, you can directly reference its Sheet1 and Set a worksheet object reference to a variable.
Sub Import()
Dim MyPath As String, strFileName As String
Dim wbkS As Workbook, wshS As Worksheet, wshT As Worksheet
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
Set wshT = Workbooks("WTF.xlsx").Worksheets("Sheet1")
wshS.Range("A1:A3").EntireRow.Delete
With wshS.Cells(1, 1).CurrentRegion
.Copy Destination:=wshT.Range("A1")
End With
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
wshT.Parent.SaveAs Filename:=MyPath & "\BBB", FileFormat:=51, CreateBackup:=False
wshT.Parent.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Another alternative would be to use the VBA equivalent of Data ► Get External Data ► From Text but you should probably know the number and type of fields being brought in with the CSV beforehand. This is certainly the preferred method if the CSV data is being incorrectly interpreted by the temp worksheet you are creating by opening the CSV as a workbook.

Combining data from multiple workbooks into a master

I have been searching forums and just can't work out the issue with my code. I am very new to macros and I'm sure it's something simple, like some variable not being defined, but I can't figure it out.
I am trying to load data from multiple workbooks into a master and really need help please!
Dir for source files: C:\Test Dir\
Dir for Master: C:\Test Dir\Master\
Source filenames differ, but all end in "*FORMATTED.xlsx."
Master filename: "Payroll Master.xlsx"
Source worksheet name = "Loaded Data"
Master worksheet name = "Summary"
All SOURCE data is in A2:J106.
The top row in the source and Master files are column headers and are identical.
I am loading all data into the Master file "Summary" worksheet.
My latest error is: "Run-time error '1004': Select method of Range class failed." on the "Sheets("Loaded Data").Range("A2:J106").Select" line
This is my current code:
Sub combine_data()
'
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
'Dim MyTemplate As Workbook
'Dim SumTemplate As Workbook
MyPath = "C:\Test Dir\"
SumPath = "C:\Test Dir\Master\"
MyTemplate = "*.xlsx" 'Set the template.
SumTemplate = "Payroll MASTER.xlsx"
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
SumName = Dir(SumPath & SumTemplate)
Do While MyName <> ""
Workbooks.Open MyPath & MyName
Sheets("Loaded Data").Range("A2:J106").Select
Selection.Copy
Workbooks.Open SumPath & SumName
Sheets("Summary").Select
Range("A65536").End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks(MyName).Close SaveChanges:=False 'close
Workbooks(SumName).Close SaveChanges:=True
MyName = Dir 'Get next file
Loop
End Sub
Thank you!
To reduce bugs, you should state Option Explicit at the top of the module. You will then be told when using variables that are not declared and you reduce the risk of misspelling the names of variables.
You should put the SumName = Dir(SumPath & SumTemplate) just before the loop, as the Dir at the end of your Do While ... Loop will refer to the LAST Dir that had parameters. When getting past the error with the Select that you describe, you have ran into this problem.
Inside your loop, you should refer to each workbook/worksheet individually, to clarify what you are doing (helping yourself for the future).
You are opening and closing the MASTER file for every source-file. You could open it before the Loop and close it after. This will make your script faster.
Here is the code modified with the above comments:
Option Explicit
Sub combine_data()
'
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
'Define folders and filenames
MyPath = "C:\Test Dir\"
SumPath = "C:\Test Dir\Master\"
MyTemplate = "*.xlsx" 'Set the template.
SumTemplate = "Payroll MASTER.xlsx"
'Open the template file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName
Set sumWS = ActiveWorkbook.Worksheets("Summary")
'Open each source file, copying the data from each into the template file
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open MyPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Loaded Data")
'Copy the data from the source and paste at the end of Summary sheet
myWS.Range("A2:J106").Copy
sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop
'Now all sourcefiles are copied into the Template file. Close and save it
Workbooks(SumName).Close SaveChanges:=True
End Sub