D
Demi
I need to export a file from Excel in a space delimited Fixed width
text file for a legacy application.
I have the following routine which works terrific except for dates.
No matter what the custom appearance of the date is formated when it
exports the date it is in the starting view of the date.
so... 12/13/2009 formatted as date and custom to look like 2009-12-13
still comes out as 12/13/2009
ANY IDEAS on how to get the custom date format exported?
here is my export routine...
Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As
Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String
'get a freefile
Dim fNum As Long
fNum = FreeFile
'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'----------------------------------------------------
'----------------------------------------------------
'*** use 2 rather than 1 to ignore header rows ***
'----------------------------------------------------
'----------------------------------------------------
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may
want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the
difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell),
Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum
MsgBox "All Finished"
End Sub
'for example the code could be called using:
' Be on the sheet you want to save as a text file and when the
dialog box
' comes up to save the work specify the new name you want to create,
' remember the directory you used to save the file in.
Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below
+1
Dim s(11) As Integer
'starting at 0 specify the width of each column
s(0) = 11
s(1) = 200
s(2) = 11
s(3) = 50
s(4) = 50
s(5) = 50
s(6) = 18
s(7) = 50
s(8) = 50
s(9) = 54
s(10) = 16
s(11) = 16
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub
text file for a legacy application.
I have the following routine which works terrific except for dates.
No matter what the custom appearance of the date is formated when it
exports the date it is in the starting view of the date.
so... 12/13/2009 formatted as date and custom to look like 2009-12-13
still comes out as 12/13/2009
ANY IDEAS on how to get the custom date format exported?
here is my export routine...
Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As
Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String
'get a freefile
Dim fNum As Long
fNum = FreeFile
'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'----------------------------------------------------
'----------------------------------------------------
'*** use 2 rather than 1 to ignore header rows ***
'----------------------------------------------------
'----------------------------------------------------
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may
want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the
difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell),
Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum
MsgBox "All Finished"
End Sub
'for example the code could be called using:
' Be on the sheet you want to save as a text file and when the
dialog box
' comes up to save the work specify the new name you want to create,
' remember the directory you used to save the file in.
Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below
+1
Dim s(11) As Integer
'starting at 0 specify the width of each column
s(0) = 11
s(1) = 200
s(2) = 11
s(3) = 50
s(4) = 50
s(5) = 50
s(6) = 18
s(7) = 50
s(8) = 50
s(9) = 54
s(10) = 16
s(11) = 16
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub