Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 361
Default XLS to CSV Code Problem

I am using the code below to convert (and save) a worksheet to a csv file.
For some reason, the code is not saving the entire contents of the worksheet.

Can someone recommend a change to the code so that it will convert and save
the entire contents of the selected worksheet ?

Thank you in advance.

Sheets(Array("1", "2")).Select

Sheets("1").Activate

' save selected sheets as individual workbooks and convert to csv

'

ChDir "J:\PROJECTS\close"

Dim sh As Worksheet

Dim Nwb As Workbook

Application.ScreenUpdating = False

For Each sh In ActiveWindow.SelectedSheets

sh.Copy

Set Nwb = ActiveWorkbook

Nwb.SaveAs Filename:=sh.Name & "_" & Format(Now, "mm-dd-yy")

Nwb.Close False

Next

'Application.ScreenUpdating = True

'ActiveWorkbook.Close savechanges:=False



'convert selected sheets to csv





Dim FName As Variant

Dim N As Long

Dim Awb As Workbook

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls),
*.xls", _

MultiSelect:=True)



If IsArray(FName) Then

Application.ScreenUpdating = False

For N = LBound(FName) To UBound(FName)

Set Awb = Workbooks.Open(FName(N))



ExportToTextFile Left(Awb.Name, Len(Awb.Name) - 4) & ".csv",
";", False



Awb.Close savechanges:=False

Next

Application.ScreenUpdating = True

End If



Application.ScreenUpdating = True

ActiveWorkbook.Close savechanges:=False

End Sub



Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly 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





Application.ScreenUpdating = False

On Error GoTo EndMacro:

FNum = FreeFile



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



Open FName For Output Access Write As #FNum



For RowNdx = StartRow To EndRow

WholeLine = ""

For ColNdx = StartCol To EndCol

If Cells(RowNdx, ColNdx).Value = "" Then

CellValue = Chr(34) & Chr(34)

Else

CellValue = Cells(RowNdx, ColNdx).Text

End If

WholeLine = WholeLine & CellValue & Sep

Next ColNdx

WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))

Print #FNum, WholeLine

Next RowNdx



EndMacro:

On Error GoTo 0

Application.ScreenUpdating = True

Close #FNum



End Sub

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Strange problem with Code PH NEWS Excel Worksheet Functions 1 September 27th 06 10:16 AM
Little problem with this code... simonsmith Excel Discussion (Misc queries) 11 May 21st 06 04:02 AM
Can anyone figure this code problem please simonsmith Excel Discussion (Misc queries) 1 May 18th 06 08:20 PM
Problem with criteria when using it from VBA Code Alvaro Silva Excel Worksheet Functions 0 December 15th 05 12:25 AM
Problem with Date format from VBA code twig Excel Discussion (Misc queries) 3 December 7th 04 06:01 PM


All times are GMT +1. The time now is 09:35 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"