I am using a macro to close several files and one of them uses a current date in the file name. I need the macro to click in the workbook and then close it and save it. I think I almost have it but I just can'tget the macro to click in the active workbook, which filename will change daily. This is what I have.
Dim ClosePath As String
Dim ClosePathDate As String
ClosePath = "File_":
ClosePathDate = ClosePath & Format(Date, "YYYYMMDD") & ".xlsx"
Windows("ClosePathDate").Activate
Sheets("Sheet1").Select
Range("A1").Select
ActiveWorkbook.Close SaveChanges:=True
I am not sure how to use " Windows("ClosePathDate") " I also tried Windows=ClosePathDate.Activate, no luck.
Please help.
This will work even if the workbook is open in another Excel Instance. BTW, you do not need to select it in order to close it.
Sub Sample()
Dim ClosePath As String
Dim ClosePathDate As String
Dim xlObj As Object
ClosePath = "File_":
ClosePathDate = ClosePath & Format(Date, "YYYYMMDD") & ".xlsx"
'~~> Replace "C:\" with the relevant path
Set xlObj = GetObject("C:\" & ClosePathDate)
xlObj.Application.Workbooks(ClosePathDate).Close SaveChanges:=False
End Sub
Another way
Sub Sample()
Dim wb As Workbook
Dim ClosePath As String
Dim ClosePathDate As String
ClosePath = "File_":
ClosePathDate = ClosePath & Format(Date, "YYYYMMDD") & ".xlsx"
Set wb = Workbooks(ClosePathDate)
wb.Close SaveChanges:=False
End Sub
Related
I'm still working on learning VBA, so this might be a dumb question, but I'm looking to loop through a workbook of ~ 90-95 sheets, break each out into its own workbook, and save it as the name of the worksheet from the original file.
The script works, but only if I comment out the .Worksheets(1).Delete, and I'm wondering why...It throws a 1004 error on both sheets that I'm running it against, but not in the same spot. The first sheet errors out on tab 4, the second on tab 40-something.
Right now I've got the FileNamePrefix variable set up to toggle, because I'm running this in the VBA window under "ThisWorkbook", since I haven't figured out how to run this macro from its own sheet, and choose the prefix based on the name/extension of the file it maps to. (AC comes to me as a .xlsm, CC as a .xlsx) That is still on my to-do, so no spoilers, please! :)
Macro:
Sub Sheet_SaveAs()
Dim wb As Workbook
Dim WS_Count As Integer
Dim ActiveSheetName As String
Dim ws As Worksheet
Dim FileNamePrefix As String
Dim FileName As String
Dim FilePath As String
'FileNamePrefix = "CC Dashboard "
FileNamePrefix = "AC Dashboard "
WS_Count = ActiveWorkbook.Worksheets.Count
MsgBox (" This will create: " & WS_Count & " Files")
For Each ws In ThisWorkbook.Worksheets
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
ThisWorkbook.Worksheets(ws.Name).Copy After:=.Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
.SaveAs ThisWorkbook.Path & "\" & FileNamePrefix & ws.Name
.Close False
End With
ws.Name = FileNamePrefix & ws.Name
Next
MsgBox (" Done! ")
End Sub
So lets get rid of the Delete and just create the new file with only the worksheet you want. I also did a little clean up on your code.
Sub Sheet_SaveAs()
Dim wb As Workbook
Dim WS_Count As Integer
Dim ActiveSheetName, FileNamePrefix, FileName, FilePath As String
Dim ws As Worksheet
'FileNamePrefix = "CC Dashboard "
FileNamePrefix = "AC Dashboard "
WS_Count = ActiveWorkbook.Worksheets.Count
MsgBox (" This will create: " & WS_Count & " Files")
For Each ws In ThisWorkbook.Worksheets
ws.Copy 'this creates a new file with only the one sheet, so no Delete needed
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & FileNamePrefix & ws.Name
ActiveWorkbook.Close False
Next
MsgBox (" Done! ")
End Sub
I'm trying to combine/nest 3 different functions in Excel VBE: open, loop, and click. I have them written out separately, but am unsure of how to combine them. I've tried the "call macro" function but got a compile error returned to me.
The goal is to open a bunch of files within a certain folder and click on the URL in all of them (the URL will not always be the same, so I need a click function that targets any unknown URL within a sheet).
Open macro:
Sub openMyfile()
Dim Source As String
Dim StrFile As String
Source = "/users/kmogilevsky/Desktop/IC_new/"
StrFile = Dir("/users/kmogilevsky/Desktop/IC_new/")
Do While Len(StrFile) > 0
Workbooks.Open Filename:=Source & StrFile
StrFile = Dir("/users/kmogilevsky/Desktop/IC_new/")
Loop
End Sub
Loop macro:
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
Set MySource = MyObj.GetFolder("/users/kmogilevsky/Desktop/IC_new/")
For Each file In MySource.Files
If InStr(file.Name, "test") > 0 Then
End If
Next file
End Sub
Click macro (this needs some work):
Private Sub CommandButton1_Click()
Call NewSub
End Sub
Sub ReadWorkbooksInCurrentFolder()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim MyPath As String
Dim strFilename As String
'Stop annoying popups while macro is running
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
'When working with many open workbooks its good to explicitly reference all workbooks, makes sure your code works and easier to read, understand and remember which workbook is which.
Set wbDst = ThisWorkbook
srcSheetName = "Data"
dstSheetName = "Results"
'I want to loop through all .xlsx files in the folder
MyPath = ThisWorkbook.Path
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFilename) = 0 Then
MsgBox "No workbooks found ending in .xlsx in current folder"
Exit Sub
End If
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Call CollectData(wbDst, wbSrc, dstSheetName, srcSheetName)
wbSrc.Close
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub CollectData(ByRef wbDst as Workbook, ByRef wbSrc as Workbook, dstSheetName as String, srcSheetName as String)
'Copy cell A1 contents in source workbook to destination workbook cell A1
wbDst.Sheets(dstSheetName).Range("A1") = wbSrc.Sheets(srcSheetName).Range("A1")
End Sub
Please edit the subroutine CollectData() so that it suits your needs, i.e. performs the click / url open. (I am not familiar with opening urls from excel, but I loop through workbooks often)
This code will open all Excel files in the IC_New folder on the desktop.
It will then look at each sheet and follow any hyperlinks that are on the sheet.
Sub Open_ClickHyperlinks()
Dim sPath As String
Dim vFiles As Variant
Dim vFile As Variant
Dim wrkBk As Workbook
Dim wrkSht As Worksheet
Dim HLink As Hyperlink
sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & _
"IC_New" & Application.PathSeparator
'Return all files that have an extension starting with xls.
vFiles = EnumerateFiles(sPath, "xls*")
'Loop through each file.
For Each vFile In vFiles
'Open the file
Set wrkBk = Workbooks.Open(Filename:=vFile, UpdateLinks:=False)
With wrkBk
'Loop through each worksheet in the file.
For Each wrkSht In .Worksheets
'Loop through each hyperlink on the worksheet.
For Each HLink In wrkSht.Hyperlinks
HLink.Follow
Next HLink
Next wrkSht
.Close SaveChanges:=False
End With
Next vFile
End Sub
'Get all files in the specified folder, default to include all subfolders as well.
Public Function EnumerateFiles(sDirectory As String, _
Optional sFileSpec As String = "*", _
Optional InclSubFolders As Boolean = True) As Variant
EnumerateFiles = Filter(Split(CreateObject("WScript.Shell").Exec _
("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _
IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".")
End Function
I have been able to get some code to open the most up to date file located on a share drive. The part of code that i'm really struggling with is the last part which tries to copy and paste the contents of that file into my master - i tried recording this last part and alter that code but have had no luck - i feel like im on the right track but would appreciate any pointers! the specific error is "Run-time error '1004'"
Sub GetLatestFile()
Dim strFolder As String
Dim strFile As String
Dim latestFile As String
Dim dtLast As Date
' assign variables
strFolder = "Z:\PRICING1\1Mbs Pricing1\MBSREVAL11\21016111\" 'The end of this path must have a \ on it
strFile = Dir(strFolder & "\*.*", vbNormal) ' Any File
' strFile = Dir(strFolder & "\*.xls*", vbNormal) ' Excel Files
' strFile = Dir(strFolder & "\*.csv", vbNormal) ' CSV Files
' loop through files to find latest modified date
Do While strFile <> ""
If FileDateTime(strFolder & strFile) > dtLast Then
dtLast = FileDateTime(strFolder & strFile)
latestFile = strFolder & strFile
End If
strFile = Dir
Loop
MsgBox latestFile
Workbooks.Open (latestFile)
Worksheets("Ratesheet").Activate
Range(A7).Select
Selection.copy
Windows("RMBS Pricing_New v5 (version 1) [Autosaved]").Activate
Range("A7").Select
ActiveSheet.Paste
Windows(latestFile).Activate
End Sub
Assuming that RMBS ... is the master file:
Workbooks.Open(latestFile)
Worksheets("Ratesheet").Activate
Range("A7").Select
Selection.copy
' ActiveWorkbook.Close if needed
Workbooks.Open("RMBS Pricing_New v5 (version 1) [Autosaved]")
Range("A7").Select
Selection.Paste
' Save/close as needed
This is the simplest way to achieve what you want. Avoid the use of .Select/.Activate. You may want to see THIS
My Assumptions:
The file that you are trying to open can be opened in Excel
You are running the code from RMBS Pricing_New v5 (version 1). If not then declare another workbook object and assign this workbook to that object.
Is this what you are trying? (Untested)
Sub GetLatestFile()
Dim strFolder As String, strFile As String, latestFile As String
Dim dtLast As Date
Dim wbThis As Workbook, wbThat As Workbook
Dim wsThis As Worksheet, wsThat As Worksheet
Set wbThis = ThisWorkbook
'<~~ Change this to the relevant sheetname where you want to paste
Set wsThis = wbThis.Sheets("Sheet1")
'
'~~> Your code to find the latest file
'
Set wbThat = Workbooks.Open(latestFile)
Set wsThat = wbThat.Sheets("Ratesheet")
wsThat.Range(A7).Copy wsThis.Range("A7")
End Sub
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.
I want to write an VBA makro to save selected excel sheets as csv files. What did I collect up to know:
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "G:\...\Create csv\" & Format(Date, "YYYYMMDD") & "_csv Save" & "\"
If Len(Dir(SaveToDirectory, vbDirectory)) = 0 Then
MkDir SaveToDirectory
End If
For Each WS In ThisWorkbook.Worksheets
If WS.Name = "Government_debt" Or WS.Name = "Domestic_demand" Or (...) Then
WS.SaveAs SaveToDirectory & WS.Name, xlCSV
End If
Next
What do I need to complete it?
I need the time after the date, in case I need to run the makro twice a day.
"YYYYMMDDHHMM" as solution gives me 201504280000
I want to create the directory in that way, that it is the folder of the file, in which the makro is. I tried already CurDir() and Application.ActiveWorkbook.Path but without success
I want to exclude some excel sheets instead of choosing only the ones to save. E.g I have some sheets "calc_(...)" which I do not need. How can I do that.
Thanks in advance!