PDA

View Full Version : excel save as csv



mpearce
11-16-2009, 02:09 PM
I have a save as routine here:

Sub save(ByVal refdate As String, ByVal day As String, ByVal month As String, ByVal year As String, ByVal importfilepath As String)
month = Mid(refdate, 5, 2)
day = Right(refdate, 2)
year = Left(refdate, 4)
refdate = month & "-" & day & "-" & year
importfilepath = "X:\nah\NAH files\Imported Files\BWMC Referrals " & refdate & ".csv"

MsgBox refdate
MsgBox importfilepath
Workbooks(2).Activate
ChDir "X:\nah\NAH files\Imported Files"
ActiveWorkbook.SaveAs Filename:=importfilepath, FileFormat:=xlCSV, CreateBackup:=False
End Sub

is there a way to get the line in bold to work with a pipe as the delimiter? i have pipe specified as my default list separator under regional setting in control panel but .saveas still uses a comma and encloses the fields in quotes.

what i am getting is "name","account_number" (plus other fields)
what i need is name|account_number (plus other fields)

any thoughts?

GTO
11-16-2009, 09:13 PM
is there a way to get the line in bold to work with a pipe as the delimiter?

i have pipe specified as my default list separator under regional setting in control panel but .saveas still uses a comma and encloses the fields in quotes.

what i am getting is "name","account_number" (plus other fields)
what i need is name|account_number (plus other fields)

any thoughts?

Greetings mpearce,

I tried to replicate and found that if I changed the default seperator to a pipe (thru regional settings as you decribed), indeed, I could manually saveas a workbook and everything was fine.

But if I programattically did the saveas, sure as heck, there were commas being used.

In fact, with the settings still changed to pipe character, when opening the programattically saved/created csv, the data was in col 1, as excel was looking for the pipes.

Weird...

Well, maybe someone has a better answer, but as .csv literally stands for Comma Seperated Values, I think you might have a problem if needing to keep the pipe.

You could of course take the date from the sheet and write it to a textfile, saving said with the csv extension.

This seems to work:

Sub callit()
Call ExportWithOtherDelimiter("csv", "|", "Sheet1")
End Sub

Public Sub ExportWithOtherDelimiter(Ext As String, Delimiter As String, Optional ShName As String)
Dim wksSource As Worksheet
Dim lFileNum As Long, x As Long, y As Long
Dim aryUsedRnge As Variant
Dim strTemp As String
If IsEmpty(ShName) Then
Set wksSource = ActiveSheet
Else
Set wksSource = ThisWorkbook.Worksheets(ShName)
End If

aryUsedRnge = wksSource.UsedRange.Value

lFileNum = FreeFile
Open ThisWorkbook.Path & "\" & "Test." & Ext For Output As #lFileNum


For x = LBound(aryUsedRnge, 1) To UBound(aryUsedRnge, 1)
For y = LBound(aryUsedRnge, 2) To UBound(aryUsedRnge, 2)
strTemp = strTemp & aryUsedRnge(x, y) & Delimiter
Next
strTemp = Left(strTemp, Len(strTemp) - 1)

Print #lFileNum, Left(strTemp, Len(strTemp) - 1)
strTemp = vbNullString
Next

Close #lFileNum
End Sub


Hope that helps?

Mark

mpearce
11-17-2009, 10:44 AM
GTO,

would this replace my other saveas routine or with in addition to it? your routine doesn't look like it is doing any saving at all, unless i missed something.

GTO
11-17-2009, 08:51 PM
My suggestion/example was to show a possible way to save the desired worksheet as a new csv file, with the pipe char being the delimiter.

Try the code in a new wb. Add some values to Sheet1, save the wb to whatever folder, and run 'callit()'.

It should create a new .csv file in the same folder, said file having the pipe as the delimiter.

Mark

mpearce
11-23-2009, 01:12 PM
maybe i am implementing this wrong in my code so ill post all that i have:

Private Sub CommandButton1_Click()
Dim refdate As String
Dim file As String
Dim day As String
Dim month As String
Dim year As String
Dim dayofweek As Integer
Dim dayofweekname As String

Call getdayofweekname(dayofweek, dayofweekname)
If dayofweekname = "Monday" Then
refdate = InputBox("Enter the date of the file for processing:", "Enter date of file", "YYYMMDD")
End If
Call getfilename(refdate, file)
Call import(file)
Call process
Call copytonewbook
'Call save(refdate, day, month, year, importfilepath)
Call ExportWithOtherDelimiter("csv", "|", "Sheet1")

Unload Me
End Sub
Sub getdayofweekname(ByRef dayofweek As Integer, ByRef dayofweekname As String)

dayofweek = Weekday(Date)
dayofweekname = WeekdayName(2)
MsgBox dayofweekname
End Sub
Sub getfilename(ByRef refdate As String, ByRef file As String)
dteCurrent = Date

dteday = day(dteCurrent)
dtemonth = month(dteCurrent)
dteyear = year(dteCurrent)

If dteday < 10 Then
dteday = 0 & dteday
End If
If dtemonth < 10 Then
dtemonth = 0 & dtemonth
End If

'refdate = dteyear & dtemonth & dteday
refdate = "20091025"
MsgBox "Refdate " & refdate
file = "X:\nah\NAH files\nahdecplace." & refdate
MsgBox "import file path: " & file
End Sub
Sub import(ByRef file As String)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range("A1"))
.Name = "nahdecplace.20091025"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Sub process()
ActiveWindow.SmallScroll ToRight:=26
Columns("AO:AO").Select
Selection.NumberFormat = "0.00"
Range("A1").Select
End Sub
Sub copytonewbook()
Workbooks.Add
Workbooks("BWMC import prep.xls").Activate
Sheets("Sheet1").Activate
Cells.Select
Selection.Copy
Workbooks(2).Activate
ActiveSheet.Paste

Workbooks("BWMC import prep.xls").Activate
Application.CutCopyMode = False
Selection.ClearContents
Selection.QueryTable.Delete

End Sub
Sub save(ByVal refdate As String, ByVal day As String, ByVal month As String, ByVal year As String, ByVal importfilepath As String)
month = Mid(refdate, 5, 2)
day = Right(refdate, 2)
year = Left(refdate, 4)
refdate = month & "-" & day & "-" & year
'importfilepath = "X:\nah\NAH files\Imported Files\BWMC Referrals " & refdate & ".csv"


MsgBox refdate
MsgBox importfilepath
Workbooks(2).Activate
'ChDir "X:\nah\NAH files\Imported Files"
ChDir "c:\"
ActiveWorkbook.SaveAs Filename:=importfilepath, FileFormat:=xlCSV, CreateBackup:=False
End Sub
Public Sub ExportWithOtherDelimiter(Ext As String, Delimiter As String, Optional ShName As String)
Workbooks(2).Activate
MsgBox Workbooks(2).FullName
Dim wksSource As Worksheet
Dim lFileNum As Long, x As Long, y As Long
Dim aryUsedRnge As Variant
Dim strTemp As String
If IsEmpty(ShName) Then
Set wksSource = ActiveSheet
Else
Set wksSource = ThisWorkbook.Worksheets(ShName)
End If

aryUsedRnge = wksSource.UsedRange.Value

lFileNum = FreeFile
Open ThisWorkbook.Path & "\" & "Test." & Ext For Output As #lFileNum


For x = LBound(aryUsedRnge, 1) To UBound(aryUsedRnge, 1)
For y = LBound(aryUsedRnge, 2) To UBound(aryUsedRnge, 2)
strTemp = strTemp & aryUsedRnge(x, y) & Delimiter
Next
strTemp = Left(strTemp, Len(strTemp) - 1)

Print #lFileNum, Left(strTemp, Len(strTemp) - 1)
strTemp = vbNullString
Next

Close #lFileNum
End Sub

if i run this as is i get a test.csv with nothing but pipes in it. any idea where i went wrong?