B
Bobby
Hi ,
i am converting the worksheet data into a text file using some decimeter
using the following code. But the data format of YYYY-MM-DD value is
converting wrong in the text file. Please find the value i am using and my
code for converting to the text file.
***********
Base_Date: 2009-03-30
it is populating as "Base_Date;39902" in text file.
***********
Code
*******
Public Function AppendData(fileName As String)
Dim ts As TextStream
Dim fileContent As String, delimiter As String
Dim rowCount As Long, columnCount As Long, dataColumn As Long, pageSize
As Long
Dim pageNumber As Integer
Dim tempRange As Range, tempCell As Range
Dim fso As FileSystemObject
ActiveWorkbook.Worksheets("Anvil").Cells.ClearContents
columnCount = GetColumnCount
pageNumber = 1
pageSize = MAX_CONCAT_COL
delimiter = GetDelimiter(ActiveSheet.CodeName)
Do While (pageNumber - 1) * pageSize < columnCount
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(1,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = ConcatFunction(delimiter, pageNumber,
pageSize, columnCount)
End With
' Calling ConcatFunctionRow function for rows other than the
header
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(2,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = ConcatFunctionRow(delimiter, pageNumber,
pageSize, columnCount)
End With
pageNumber = pageNumber + 1
Loop
If pageNumber > 2 Then
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(1,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = MasterConcatFunction(pageNumber - 1)
End With
' Calling MasterConcatFunction function for rows other than the
header
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(2,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = MasterConcatFunction(pageNumber - 1)
End With
dataColumn = pageNumber
Else
dataColumn = 1
End If
rowCount = GetRowCount
If rowCount > 2 Then
Range(ActiveWorkbook.Worksheets("Anvil").Cells(2, 1), _
ActiveWorkbook.Worksheets("Anvil").Cells(rowCount,
dataColumn)).FillDown
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fspenTextFile(fileName, ForWriting, True)
With Range(ActiveWorkbook.Worksheets("Anvil").Cells(1, dataColumn), _
ActiveWorkbook.Worksheets("Anvil").Cells(rowCount, dataColumn))
For Each tempCell In .Cells
If tempCell.Row < rowCount Then
tempCell.Value = Left(tempCell.Value,
Len(tempCell.Value) - 1)
If tempCell.Value <> "Flat_File_Field_Delimiter;;" Then
Call ts.WriteLine(tempCell.Value)
End If
Else
tempCell.Value = Left(tempCell.Value,
Len(tempCell.Value) - 1)
Call ts.Write(tempCell.Value)
End If
Next
End With
ActiveWorkbook.Worksheets("Anvil").Cells.ClearContents
ts.Close
Exit Function
End Function
Public Function ConcatFunction(delimiter As String, pageNumber As Integer, _
pageSize As Long, columnCount As Long) As String
Dim index As Integer, startIndex As Integer, endIndex As Integer
Dim concatString As String, sheetName As String
sheetName = ActiveSheet.Name
concatString = "="
startIndex = (pageNumber - 1) * pageSize + 1 - pageNumber
endIndex = IIf(columnCount < pageNumber * pageSize, _
columnCount - pageNumber, pageNumber * (pageSize - 1))
'incorporated the dynamic value of the delimiter
For index = startIndex To endIndex
concatString = concatString & " '" & Replace(sheetName, "'", "''") & _
"'!RC[" & index & "] & """ & delimiter & """"
If index < endIndex Then concatString = concatString & " & "
Next
ConcatFunction = concatString
End Function
'added a new function to cater to all the rows(other than the header)
concatentaion
Public Function ConcatFunctionRow(delimiter As String, pageNumber As
Integer, _
pageSize As Long, columnCount As Long) As String
Dim index As Integer, startIndex As Integer, endIndex As Integer
Dim concatString As String, sheetName As String, temp As String
sheetName = ActiveSheet.Name
concatString = "="
startIndex = (pageNumber - 1) * pageSize + 1 - pageNumber
endIndex = IIf(columnCount < pageNumber * pageSize, _
columnCount - pageNumber, pageNumber * (pageSize - 1))
For index = startIndex To endIndex
temp = Sheets(sheetName).Cells(2, index + pageNumber).NumberFormat
'For bug 5402115
If temp = "@" Then
concatString = concatString & " IF('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]="""","""",'" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]) & """ & delimiter & """"
Else
concatString = concatString & " IF('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]="""","""",text('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "],""" & temp & """)) & """ & delimiter &
""""
End If
If index < endIndex Then concatString = concatString & " & "
Next
ConcatFunctionRow = concatString
End Function
Sub Cancel_Click()
ActiveWorkbook.Names("CurrentTag").RefersToRange.Value = ""
End Sub
Public Function GetColumnCount() As Integer
Dim tempRange As Range
If ActiveSheet.Range("A1").Value = "" Then
GetColumnCount = 0
Else
GetColumnCount = _
ActiveSheet.Range("A1").End(xlToRight).End(xlToRight).End(xlToLeft).Column
End If
End Function
Public Function GetRowCount() As Long
GetRowCount = ActiveSheet.UsedRange.Rows.Count
End Function
Public Function MasterConcatFunction(pageCount As Integer) As String
Dim index As Integer
Dim concatString As String
concatString = "="
For index = pageCount To 1 Step -1
concatString = concatString & " RC[-" & index & "]"
If index > 1 Then concatString = concatString & " & "
Next
MasterConcatFunction = concatString
End Function
i am converting the worksheet data into a text file using some decimeter
using the following code. But the data format of YYYY-MM-DD value is
converting wrong in the text file. Please find the value i am using and my
code for converting to the text file.
***********
Base_Date: 2009-03-30
it is populating as "Base_Date;39902" in text file.
***********
Code
*******
Public Function AppendData(fileName As String)
Dim ts As TextStream
Dim fileContent As String, delimiter As String
Dim rowCount As Long, columnCount As Long, dataColumn As Long, pageSize
As Long
Dim pageNumber As Integer
Dim tempRange As Range, tempCell As Range
Dim fso As FileSystemObject
ActiveWorkbook.Worksheets("Anvil").Cells.ClearContents
columnCount = GetColumnCount
pageNumber = 1
pageSize = MAX_CONCAT_COL
delimiter = GetDelimiter(ActiveSheet.CodeName)
Do While (pageNumber - 1) * pageSize < columnCount
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(1,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = ConcatFunction(delimiter, pageNumber,
pageSize, columnCount)
End With
' Calling ConcatFunctionRow function for rows other than the
header
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(2,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = ConcatFunctionRow(delimiter, pageNumber,
pageSize, columnCount)
End With
pageNumber = pageNumber + 1
Loop
If pageNumber > 2 Then
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(1,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = MasterConcatFunction(pageNumber - 1)
End With
' Calling MasterConcatFunction function for rows other than the
header
Set tempRange = ActiveWorkbook.Worksheets("Anvil").Cells(2,
pageNumber)
With tempRange
.NumberFormat = "General"
.FormulaR1C1 = MasterConcatFunction(pageNumber - 1)
End With
dataColumn = pageNumber
Else
dataColumn = 1
End If
rowCount = GetRowCount
If rowCount > 2 Then
Range(ActiveWorkbook.Worksheets("Anvil").Cells(2, 1), _
ActiveWorkbook.Worksheets("Anvil").Cells(rowCount,
dataColumn)).FillDown
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fspenTextFile(fileName, ForWriting, True)
With Range(ActiveWorkbook.Worksheets("Anvil").Cells(1, dataColumn), _
ActiveWorkbook.Worksheets("Anvil").Cells(rowCount, dataColumn))
For Each tempCell In .Cells
If tempCell.Row < rowCount Then
tempCell.Value = Left(tempCell.Value,
Len(tempCell.Value) - 1)
If tempCell.Value <> "Flat_File_Field_Delimiter;;" Then
Call ts.WriteLine(tempCell.Value)
End If
Else
tempCell.Value = Left(tempCell.Value,
Len(tempCell.Value) - 1)
Call ts.Write(tempCell.Value)
End If
Next
End With
ActiveWorkbook.Worksheets("Anvil").Cells.ClearContents
ts.Close
Exit Function
End Function
Public Function ConcatFunction(delimiter As String, pageNumber As Integer, _
pageSize As Long, columnCount As Long) As String
Dim index As Integer, startIndex As Integer, endIndex As Integer
Dim concatString As String, sheetName As String
sheetName = ActiveSheet.Name
concatString = "="
startIndex = (pageNumber - 1) * pageSize + 1 - pageNumber
endIndex = IIf(columnCount < pageNumber * pageSize, _
columnCount - pageNumber, pageNumber * (pageSize - 1))
'incorporated the dynamic value of the delimiter
For index = startIndex To endIndex
concatString = concatString & " '" & Replace(sheetName, "'", "''") & _
"'!RC[" & index & "] & """ & delimiter & """"
If index < endIndex Then concatString = concatString & " & "
Next
ConcatFunction = concatString
End Function
'added a new function to cater to all the rows(other than the header)
concatentaion
Public Function ConcatFunctionRow(delimiter As String, pageNumber As
Integer, _
pageSize As Long, columnCount As Long) As String
Dim index As Integer, startIndex As Integer, endIndex As Integer
Dim concatString As String, sheetName As String, temp As String
sheetName = ActiveSheet.Name
concatString = "="
startIndex = (pageNumber - 1) * pageSize + 1 - pageNumber
endIndex = IIf(columnCount < pageNumber * pageSize, _
columnCount - pageNumber, pageNumber * (pageSize - 1))
For index = startIndex To endIndex
temp = Sheets(sheetName).Cells(2, index + pageNumber).NumberFormat
'For bug 5402115
If temp = "@" Then
concatString = concatString & " IF('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]="""","""",'" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]) & """ & delimiter & """"
Else
concatString = concatString & " IF('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "]="""","""",text('" & Replace(sheetName, "'",
"''") & _
"'!RC[" & index & "],""" & temp & """)) & """ & delimiter &
""""
End If
If index < endIndex Then concatString = concatString & " & "
Next
ConcatFunctionRow = concatString
End Function
Sub Cancel_Click()
ActiveWorkbook.Names("CurrentTag").RefersToRange.Value = ""
End Sub
Public Function GetColumnCount() As Integer
Dim tempRange As Range
If ActiveSheet.Range("A1").Value = "" Then
GetColumnCount = 0
Else
GetColumnCount = _
ActiveSheet.Range("A1").End(xlToRight).End(xlToRight).End(xlToLeft).Column
End If
End Function
Public Function GetRowCount() As Long
GetRowCount = ActiveSheet.UsedRange.Rows.Count
End Function
Public Function MasterConcatFunction(pageCount As Integer) As String
Dim index As Integer
Dim concatString As String
concatString = "="
For index = pageCount To 1 Step -1
concatString = concatString & " RC[-" & index & "]"
If index > 1 Then concatString = concatString & " & "
Next
MasterConcatFunction = concatString
End Function