Automatic save as for CSV

[Carrie_Loos via OfficeKB.com]

I have a list of csv files that I need to open re-format and then close the
file and re-name so that I can import into Access. (Access doesn't recogonize
the current name with dashes). I am manually doing a "save as" now. I was
also hoping to sequentially name the files for instance, logfile1, logfile2,
logfile3, logfile4 etc... Can it be done? If I add it to the bottom of my
format macro it would all be in one step.

Thanks

 

[Dave Peterson]

I'm not sure how you have that list or what you do to open it, but this worked
ok for me with a single .CSV file.

Option Explicit
Sub testme()

Dim myFileName As String
Dim myPath As String
Dim wks As Worksheet
Dim TestStr As String
Dim iCtr As Long
Dim MaxTries As Long
Dim NewFileName As String
Dim NextFileName As String
Dim UseThisOne As Long

MaxTries = 99

myPath = "C:\my documents\excel\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFileName = "Book1.csv"

Workbooks.Open Filename:=myPath & myFileName
Set wks = ActiveSheet

With wks
'do your manipulation here

'remove the .csv from the original filename
NewFileName = Replace(expression:=myFileName, _
Find:=".csv", _
Replace:="", _
compare:=vbTextCompare)

'remove any dashes
NewFileName = Replace(expression:=NewFileName, Find:="-", Replace:="")

'look for the next available number
UseThisOne = -1
For iCtr = 1 To MaxTries
TestStr = ""
NextFileName = myPath & NewFileName & Format(iCtr, "00") & ".csv"
On Error Resume Next
TestStr = Dir(NextFileName)
On Error GoTo 0
If TestStr = "" Then
UseThisOne = iCtr 'found it!
Exit For
End If
Next iCtr

If UseThisOne < 0 Then
MsgBox "Error--ran out of numbers, file not saved!"
Else
.Parent.SaveAs Filename:=NextFileName, FileFormat:=xlCSV
End If

.Parent.Close savechanges:=False

End With

End Sub

 

[Carrie_Loos via OfficeKB.com]

Awesome, you always come through! Thanks Dave

I'm not sure how you have that list or what you do to open it, but this worked
ok for me with a single .CSV file.

Option Explicit
Sub testme()

Dim myFileName As String
Dim myPath As String
Dim wks As Worksheet
Dim TestStr As String
Dim iCtr As Long
Dim MaxTries As Long
Dim NewFileName As String
Dim NextFileName As String
Dim UseThisOne As Long

MaxTries = 99

myPath = "C:\my documents\excel\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFileName = "Book1.csv"

Workbooks.Open Filename:=myPath & myFileName
Set wks = ActiveSheet

With wks
'do your manipulation here

'remove the .csv from the original filename
NewFileName = Replace(expression:=myFileName, _
Find:=".csv", _
Replace:="", _
compare:=vbTextCompare)

'remove any dashes
NewFileName = Replace(expression:=NewFileName, Find:="-", Replace:="")

'look for the next available number
UseThisOne = -1
For iCtr = 1 To MaxTries
TestStr = ""
NextFileName = myPath & NewFileName & Format(iCtr, "00") & ".csv"
On Error Resume Next
TestStr = Dir(NextFileName)
On Error GoTo 0
If TestStr = "" Then
UseThisOne = iCtr 'found it!
Exit For
End If
Next iCtr

If UseThisOne < 0 Then
MsgBox "Error--ran out of numbers, file not saved!"
Else
.Parent.SaveAs Filename:=NextFileName, FileFormat:=xlCSV
End If

.Parent.Close savechanges:=False

End With

End Sub

I have a list of csv files that I need to open re-format and then close the
file and re-name so that I can import into Access. (Access doesn't recogonize

[quoted text clipped - 8 lines]

Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/ms-excel/201004/1