PDA

View Full Version : URGENT: APPEND DATA



phio3nix
11-30-2011, 08:30 PM
I found the code of Mr. Charles H. Pearson in his site and made some revisions. Through this code, It only exports the selected rows and columns from the first sheet. My problem is how selected rows and columns from multiple sheets be exported to one csv file. Hope someone can help me with this issue. Thanks.

Here's my code:


Sub FormattedDoTheExport()
Dim filename As Variant
Dim Sep As String
'prompt to ask where and what to call the exported file using Windows built in File Explorer
filename = Application.GetSaveAsFilename(InitialFileName:="Test-" & _
Format(Date, "mm-dd-yy"), fileFilter:="CSV Files (*.csv),*.csv")
If filename = False Then
'user clicked the cancel button, so exit
Exit Sub
End If
' defining the file seperator, which is a comma
Sep = ","
If Sep = vbNullString Then
'seperator not defined, so exit
Exit Sub
End If
Debug.Print "FileName: " & filename, "Separator: " & Sep
' pass in from this sub the actual data to save
ExportToTextFile fname:=CStr(filename), Sep:=CStr(Sep), SelectionOnly:=False, AppendData:=False
' tell the user we've saved the file ok
MsgBox "File Exported.", vbOKOnly, "File Exported."

Exit Sub
End Sub


Public Sub ExportToTextFile(fname As String, Sep As String, SelectionOnly As Boolean, AppendData As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim sht As Excel.Worksheet

' suppress screen flicker by turning off the updating of the screen
Application.ScreenUpdating = False
FNum = FreeFile

' export only a selection
For Each sht In ThisWorkbook.Worksheets
If sht.Name = "񍐏" Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.count).Row
EndCol = .Cells(.Cells.count).Column
End With
ElseIf sht.Name = "ꗗ" Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.count).Row
EndCol = .Cells(.Cells.count).Column
End With
End If
Next sht

' to add the data at the bottom of an existing file
If AppendData = True Then
Open fname For Append Access Write As #FNum
Else
' to create a new file overwriting if data exists already in the file
Open fname For Output Access Write As #FNum
End If
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol

' if blank
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)

' if a number
ElseIf IsNumeric(Cells(RowNdx, ColNdx)) Then
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

' if a date
ElseIf IsDate(Cells(RowNdx, ColNdx)) Then
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

' if it is anything else
Else
CellValue = Chr(34) & Cells(RowNdx, ColNdx).Text & Chr(34)

End If

WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
' turn screen updating back on
Application.ScreenUpdating = True
Close #FNum
End Sub


Please see the attachment for the excel file :yes

phio3nix
11-30-2011, 10:15 PM
or is there any snippet code that can fit to my requirements with the same file given above? hope that masters of vba programming here like Kenneth Hobs, GTO, and mdmackillop could help me with this matter. thanks. :)

Requirements:
1. exporting excel data to one csv file.
2. all data should be enclose in double quotations (")
3. blank cell should output dash ("-")
4. data with enter should be replace by <br />
5. the csv filename should be the xls filename
6. only cells with data/values will be the one exported, headers on top should not be included in the exported csv file
7. Delimiter is comma (,)
8. blank sheets should not be included on the exported csv file