WascoWarrior
New Member
- Joined
- May 22, 2024
- Messages
- 9
- Office Version
- 365
- Platform
- Windows
I have a button in a XLSM spreadsheet that lets the user copy the data to a new sheet and save as a CSV file.
What I need to do before saving as a csv file, is modify the format of 2 columns-dates (currently set as text with data represented as mm/dd/yy and change the column so the data is saved as mmddyy (remove the slashes) before saving as a CSV file. How can this be accomplished using VBA. I don't want the user to manually modify the fields.
Sub CmdUploadIFS_Click()
'***************************************************************************************
'*** Save Spreadsheet as csv ***
'***************************************************************************************
Dim MyPath As String
Dim MyFileName As String
Dim FullPath As String
Dim WB1 As Workbook, WB2 As Workbook
Dim rng As Range
Dim todaydate As Date
MyPath = "C:\UPLOAD\UPLOADPO"
Set WB1 = ActiveWorkbook
On Error Resume Next
Set rng = Range("A3:K9999")
If rng Is Nothing Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
rng.Copy
Set WB2 = Application.Workbooks.Add(1)
WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
todaydate = Now()
MyFileName = "UPLOADPO_" & Format(todaydate, "yyyymmdd_hhmmss")
FullPath = MyPath & "\" & MyFileName
Application.DisplayAlerts = False
If MsgBox("Data will be copied to: " & MyPath & "\" & MyFileName & vbCrLf & _
"Continue?", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
With WB2
.SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=True
.Close False
End With
Application.DisplayAlerts = True
End Sub
What I need to do before saving as a csv file, is modify the format of 2 columns-dates (currently set as text with data represented as mm/dd/yy and change the column so the data is saved as mmddyy (remove the slashes) before saving as a CSV file. How can this be accomplished using VBA. I don't want the user to manually modify the fields.
Sub CmdUploadIFS_Click()
'***************************************************************************************
'*** Save Spreadsheet as csv ***
'***************************************************************************************
Dim MyPath As String
Dim MyFileName As String
Dim FullPath As String
Dim WB1 As Workbook, WB2 As Workbook
Dim rng As Range
Dim todaydate As Date
MyPath = "C:\UPLOAD\UPLOADPO"
Set WB1 = ActiveWorkbook
On Error Resume Next
Set rng = Range("A3:K9999")
If rng Is Nothing Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
rng.Copy
Set WB2 = Application.Workbooks.Add(1)
WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
todaydate = Now()
MyFileName = "UPLOADPO_" & Format(todaydate, "yyyymmdd_hhmmss")
FullPath = MyPath & "\" & MyFileName
Application.DisplayAlerts = False
If MsgBox("Data will be copied to: " & MyPath & "\" & MyFileName & vbCrLf & _
"Continue?", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
With WB2
.SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=True
.Close False
End With
Application.DisplayAlerts = True
End Sub