I need to add today's date to a file name.
I have part of the code copied from another file, but it doesn't have that feature.
Where it says "/CARYYMMDD2428395101.BCA" is the place that I need to change to today's date.
Sub Export_Selection_As_Fixed_Length_File()
' Dimension all variables.
Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String
Dim FileNum, ColumnCount, RowCount, FieldWidth As Integer
Dim sht As Worksheet
'Below are options incase you want to change the folder where VBA stores the .txt file
'We use ActiveWorkbook.Path in this example
'ActiveWorkbook.Path 'the activeworkbook
'ThisWorkbook.Path 'the workbook with the code
'CurDir 'the current directory (when you hit File|open)
'If a cell is blank, what character should be used instead
Filler_Char_To_Replace_Blanks = " "
'Check if the user has made any selection at all
If Selection.Cells.Count < 2 Then
MsgBox "No row has been selected"
Selection.Activate
End
End If
'This is the destination file name.
DestinationFile = ActiveWorkbook.Path & "/CARYYMMDD24284444101.BCA"
'Obtain next free file handle number.
FileNum = FreeFile()
I expect to get the name of the file as CAR19080824284444101.BCA
First I want to point out you qualified your variables incorrectly. The line Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String only declares Filler_Char_To_Replace_Blanks as a String the rest are Variant types.
Format(Date, "yyyymmdd") is what you're looking for you can change the format however, I demonstrate below another way to name, but if you like what I here just modify it.
Sub Export_Selection_As_Fixed_Length_File()
' Dim all variables.
Dim DestinationFile As String, CellValue As String, Filler_Char_To_Replace_Blanks As String
Dim FileNum As Integer, ColumnCount As Integer, RowCountAs Integer, FieldWidth As Integer
Dim sht As Worksheet
'Below are options incase you want to change the folder where VBA stores the .txt file
'We use ActiveWorkbook.Path in this example
'ActiveWorkbook.Path 'the activeworkbook
'ThisWorkbook.Path 'the workbook with the code
'CurDir 'the current directory (when you hit File|open)
'If a cell is blank, what character should be used instead
Filler_Char_To_Replace_Blanks = " "
'Check if the user has made any selection at all
If Selection.Cells.Count < 2 Then
MsgBox "No row has been selected"
Selection.Activate
End
End If
'This is the destination file name. Unsure if you wanted a certain format, but this shows you how to add it.
DestinationFile = ActiveWorkbook.Path & "/CARYYMMDD24284444101.BCA" & Month(Date) &"."&Year(Date)
'Obtain next free file handle number.
FileNum = FreeFile()
This is some pseudo-code, which saves 'ThisWorkbook' into the specified path (directory eg. C:\Test) and adds the date to the end of the filename.
ThisWorkbook.SaveCopyAs <declare_path_variable> & **Format(Date, "dd-mm-yyyy")** & ThisWorkbook.Name
You can do it like this:
'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr
Related
I have a VBA macro in Excel which opens both the source and targets files, copies the required data and closes the files. The target filename is always the same, but the source file is a new file every day with the date as part of the name. The name format is SB20200613.DBF. This is today's file 13 June. For all of 2020, the files will always be SB2020XXXX.DBF.
Here is the macro
Public Sub Copy_DBF_to_Workbook()
Const cRootFolder As String = "C:\Price\" ' <<<<< change accordingly (without year!)
Const cDestWorkBk As String = "Prices.xlsx"
Dim oWsSrc As Worksheet
Dim oWsDest As Worksheet
Dim raSrc As Range
Dim raDest As Range
Dim sPath As String
Dim sDBF As String
Dim sFName As String
Dim dtDate As Date
' assign current date
dtDate = Date
' assign yesterday's date
' dtDate = Date - 1
' compose path for current year
sPath = cRootFolder & Year(dtDate) & "\"
' compose file name
sDBF = "SB" & Year(dtDate) & IIf(Len(Month(dtDate)) = 1, "0" & Month(dtDate), Month(dtDate)) & _
IIf(Len(Day(dtDate)) = 1, "0" & Day(dtDate), Day(dtDate)) & ".dbf"
' check within folder on existence of file
sFName = Dir(sPath & sDBF)
If Len(sFName) > 0 Then
' open DBF file
On Error Resume Next
Set oWsSrc = Workbooks.Open(sPath & sFName).ActiveSheet
If oWsSrc Is Nothing Then GoTo ERROR_DBF
' open destination workbook
Set oWsDest = Workbooks.Open(sPath & cDestWorkBk).ActiveSheet
On Error GoTo 0
If oWsDest Is Nothing Then GoTo ERROR_PRICES
' determine range to be copied
With oWsSrc.Cells.CurrentRegion
Set raSrc = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
End With
' determine destination; first available row in column B
Set raDest = oWsDest.Cells(oWsDest.Rows.Count, "B").End(xlUp).Offset(1, 0)
' perform copy
raSrc.Copy Destination:=raDest
' save prices.xlsx
oWsDest.Parent.Save
oWsDest.Parent.Close
' close DBF
oWsSrc.Parent.Close SaveChanges:=False
Else
MsgBox "DBF file [" & sPath & sDBF & "] not found.", vbExclamation
End If
GoTo DONE
ERROR_DBF:
MsgBox "Error opening DBF file " & sPath & sDBF, vbExclamation
Exit Sub
ERROR_PRICES:
MsgBox "Error opening workbook " & sPath & cDestWorkBk, vbExclamation
DONE:
End Sub
That works well for today, but I also have a data created each day for the following day, so I need to duplicate this macro, but have it look not for today's file, but for tomorrow's file. I tried simply making this change
' assign current date
dtDate = Date + 1
but the macro still performs the task on today's data file.
Any thoughts on what requires changing to have the macro open tomorrows DBF file instead?
cheers
I have an Excel file (https://www.dropbox.com/s/hv9u68s136es190/Example2.xlsx?dl=0) with in column A all the persons and in the cell next to there name text (column B).
I want to save for every person a text file containing the text in the cell next to there name.
The filename should be called like the persons name.
So in this case i would have three text files. I do not know how to manage this using VBA in Excel.
Can someone help me with this?
Try this code, please. But, you must initially try something on your own. We usually help people correct their code and learn...
The text files will be named like the people names in column A. The folder where they will be saved will be the one of the workbook which keeps the active sheet. You can define it as you need, of course.
Option Explicit
Sub SaveTxtNamePlusTekst()
Dim sh As Worksheet, lastR As Long, i As Long, strPath As String
Set sh = ActiveSheet ' use here the sheet you need
strPath = sh.Parent.path 'you can define here the path you wish...
If Dir(strpath, vbDirectory) = "" Then MsgBox "The folder path is not valid...": Exit Sub
lastR = sh.Range("A" & Cells.Rows.Count).End(xlUp).row 'Last row in A:A
For i = 2 To lastR
'calling a Sub able to create a text file in a folder and put text in it
WriteText sh.Range("A" & i).value, strPath, sh.Range("B" & i).value
Next i
End Sub
Private Sub WriteText(strName As String, strPath As String, strText As String)
Dim filePath As String
filePath = strPath & "\" & strName & ".txt" 'building the txt file path
FreeFile 1
Open filePath For Output As #1
Print #1, strText 'write the text
Close #1
End Sub
I'm trying to insert formulas into my worksheet, but my first and second attempts haven't gone so well.
So, first I thought it would be better to use the GetOpenFilename feature for accuracy's sake, rather than having the user input the name of the workbook themselves. I used this page and this answer while writing it. When I run the code, the Open dialogue box opens, but when I select a workbook I keep getting a:
"Runtime Error '424': object required".
I'm not sure what it's asking for? At first I had just Application.GetOpenFilename(), so I thought I needed to add the filter, but it didn't help.
Sub openfile()
Dim mainwb As Workbook
Set mainwb = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim mainws As Worksheet
mainws = InputBox("Please enter the name of the worksheet")
Dim rdsMonthly As Variant
rdsMonthly = InputBox("Please insert current month column in format $A:$A")
Dim rdsID As Variant
rdsID = InputBox("Please insert ID column in format $A:$A")
Cells(8, 14) = "=IFERROR(SUMIFS('[" & mainwb & "]" & mainws & "'!" & rdsMonthly & ", '[" & mainwb & "]" & mainws & "'!" & rdsID & ", $C55), " & Chr(34) & Chr(34) & ")"
End Sub
After, I tried using an Input box instead
Dim mainwb As Workbook
mainwb = InputBox("Please enter the name of the workbook, including file extension")
But that's giving me a:
"Runtime error '91': Object variable or With block variable not set".
I have no idea what it wants from me, and I'd really appreciate any help!
To get the name of the workbook, indicated with .GetOpenFileName, you may split once the big string through / and then get the last item. Then, split again by .xls and take the 0th item. With 1 line this 2 operations look like this:
Sub TestMe()
Dim filePath As String
filePath = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim nameOfWb As String
'do not do this at production, but split it to variables:
nameOfWb = Split(Split(filePath, "\")(UBound(Split(filePath, "\"))), ".xls")(0)
Debug.Print nameOfWb
End Sub
Application.GetOpenFilename("Microsoft Excel Files, *.xls*") returns a string of the workbook path. And Workbooks() needs a workbook name, which is already opened.
Try this:
Sub TestMe()
Dim mainwb As Workbook
Set mainwb = Workbooks.Open(Application.GetOpenFilename("Microsoft Excel Files, *.xls*"))
MsgBox mainwb.Name
End Sub
Application.GetOpenFileName
I have this dropdown menu on Sheet 9, and I need the macro to loop through all items in the dropdown in cell E5 and save a copy of Sheet10 as pdf with each different information referenced by the item in the dropdown list. I did not want to have to save as each document, so it would be good to have a code that could save all of the documents in an specific folder with different names according to what is writen in cell E5. (this process will happen every month, so it would be good if it could save all documents in a different folder each month). So far I have a code that just saves sheet 10, but I couldnt figure out the loop yet. Does anyone have a code that would do that? :)
I'm not sure, but I think when E5 is changed it automatically changes data on Sheet10, and so sheet1o will be different for each item selected in Sheet1.range("E5") drop down. If so, then this will work. If not, it will at least show you how to create a new folder for the current month and save your sheet10 as pdf files to that folder.
Sub testDir()
Dim mnth As String
Dim yr As String
Dim dateString As String
Dim pathToDir As String
Dim myFolder As String
Dim myFile As String
Dim totalElements
Dim element As Range
Dim wb As Workbook
Dim activeSh As Worksheet
Dim aWB As Worksheet
Set activeSh = Sheets("Sheet9")
activeSh.Activate
Set aWB = Sheets("Sheet10")
' set up folder and path for current month
pathToDir = "C:\Temp\"
mnth = Left(MonthName(Month(Date)), 3)
yr = Year(Date)
dateString = yr & "_" & mnth
myFolder = pathToDir & dateString
If Not ifFolderExists(myFolder) Then
' Folder for current month does not exist yet
' Create folder "C:\Temp\2017_Feb" or whatever current year and month is
Beep
MkDir myFolder
End If
' Get items from dropdown list
Set totalElements = Evaluate(Range("E5").Validation.Formula1)
' This is where I'm fuzzy -
' If when you select each item, does that automatically change data on Sheet10?
' If so, do this
For Each element In totalElements
if element.name <> "" then
Sheet1.Range("E5").Value = element
myFile = myFolder & "\" & "_" & element & ".pdf"
ChDir myFolder
aWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
myFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End if
Next element
End Sub
Public Function ifFolderExists(folderPath As String) As Boolean
On Error Resume Next
ifFolderExists = (GetAttr(folderPath) And vbDirectory) = vbDirectory
On Error GoTo 0
End Function
I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problems should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:
Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant '<<does the list of passwords have to be array?
sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2" '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm" '<< how to make sFile be every file in folder?
' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False
End With
End Sub
For the password array I have tried following code:
Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next 'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i
End Sub
I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.