ScatmanKyle
Board Regular
- Joined
- Oct 26, 2015
- Messages
- 65
- Office Version
- 365
- Platform
- Windows
Hi again!
I noticed one of my macros seems to have the file name in it when I try to assign it, as if it belonged to a separate workbook.
The macro essentially runs through specific sheets (based on index) and saves them to a chosen folder as separate csvs. When I run it through this, the date section of the name messes up, but when I run it directly from the macro screen, it works fine.
I noticed one of my macros seems to have the file name in it when I try to assign it, as if it belonged to a separate workbook.
The macro essentially runs through specific sheets (based on index) and saves them to a chosen folder as separate csvs. When I run it through this, the date section of the name messes up, but when I run it directly from the macro screen, it works fine.
VBA Code:
Sub CSV_Export()
Dim ws As Worksheet
Dim strFileName As String
Dim strFolderPath As String
Dim strShtType As String
Dim strFullPath As String
Dim strReplace As String
Dim fso As Object
Set fso = CreateObject("Scripting.Filesystemobject")
'Lets you choose the folder to save the csv files in
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
strFolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Runs the code for the csv tabs only (tab positions 11 through 15)
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Index
Case 11 To 15
'Skips tabs with no invoice data
If ws.Range("A16") = "" Then
GoTo NextCase
Else
'Stores the name and directory the file will be saved as
strFileName = "CDS " & Format(Month(Range("C4")), "00") & Format(Day(Range("C4")), "00") & Year(Range("C4")) & Right(ws.Name, Len(ws.Name) - 3)
strFullPath = strFolderPath & "\" & strFileName & ".csv"
'Checks if a file of the same name already exists in the chosen folder. If yes, offers the option to replace it. If no, it continues to the next tab
If Dir(strFullPath) <> "" Then
strReplace = MsgBox("File " & strFileName & ".csv already exists in folder. Do you want to replace it?", vbQuestion + vbYesNo + vbDefaultButton2, "File Already Exists")
If strReplace = vbYes Then
GoTo SaveFile
Else
GoTo NextCase
End If
Else
SaveFile:
ws.Copy
Application.DisplayAlerts = False
Application.ActiveWorkbook.SaveAs Filename:=strFullPath, FileFormat:=xlCSV, CreateBackup:=False, local:=True
Application.ActiveWorkbook.Saved = True
Application.DisplayAlerts = True
Application.ActiveWorkbook.Close False
End If
End If
End Select
NextCase:
Next ws
End Sub