View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Mintz87 Mintz87 is offline
external usenet poster
 
Posts: 5
Default Numbers 0000 will = 0 when converted to a csv file via macro

Numbers 0000 will = 0 when converted to a csv file via macro. i want my 0000
to be the value in the csv file not just 0 and 0999 to be a value not 999.
this is very important to port phone numbers in to database. the spreadsheet
has a format of text and a data validation of length 4 characters as a min
and a max. i have a 41 sheet spreadsheet with multiple columns. here is the
current macro: Please let me know what i can do, thanks.



Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String
Dim wsSheet As Worksheet
Dim nFileNum As Integer

'**** Allows you to choose your delimenter - advised not to use comma
Sep = InputBox("Enter a single delimiter character (e.g., pipe or
semi-colon)", _
"Export To Text File")


For Each wsSheet In Worksheets
wsSheet.Activate

'**** make all cells in upper case
' Sub makeupper()
For Each c In ActiveSheet.UsedRange
If Not c.HasFormula Then c.Value = UCase(c)
Next
' End Sub
'*****

nFileNum = FreeFile
Open "C:\00_Mintz\CSG_Proj\PROJECTS\baselines\Carol_Qui nn\CSV\" &
wsSheet.Name & ".csv" For Output As #nFileNum
ExportToTextFile CStr(nFileNum), Sep, False
'_
' MsgBox("Do You Want To Export The Entire Worksheet?", _
' vbYesNo, "Export To Text File") = vbNo
Close nFileNum
Next wsSheet

End Sub

Public Sub ExportToTextFile(nFileNum As Integer, _
Sep As String, SelectionOnly As Boolean)

Dim WholeLine As String
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

'--------------------------------------
' The following if statement allows you to choose
' selection or the whole sheet to be converted
Application.ScreenUpdating = False
On Error GoTo EndMacro:

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If
'--------------------------------------

For RowNdx = StartRow + 1 To EndRow 'skips the header
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = "" 'configures values around the comma values
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #nFileNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub





thanks in advance
cg