View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Ken Warthen[_2_] Ken Warthen[_2_] is offline
external usenet poster
 
Posts: 70
Default CSV code works on some, but not all machines

I have an Excel 2003 worksheet with VBA code that creates a CSV file from
data on a worksheet. The file creation works fine on my machine as well as
several others, but there are at least two machines tested where the code
creates the CSV file, but when you open it there is no data in the worksheet.
Any idea what might be causing this? My code follows. - Ken

Public Sub sExportToCSV()
Dim ThisBook As Workbook
Dim thisSheet As Worksheet
Dim thisSelection As Range
Dim newBook As Workbook
Dim NewSheet As Worksheet
Dim Cell As Range
Dim strCSVFileName As String
Dim strPath As String

Set ThisBook = Selection.Parent.Parent
Set thisSheet = ThisBook.ActiveSheet
Set thisSelection = Range("CSVExportRange")

strPath = ActiveWorkbook.Path & "\"
strCSVFileName = Format(Date, "mmddyyyy") & ".csv"

'check for existing csv file
If Len(Dir(strPath & strCSVFileName)) 0 Then
'file exists. append data
If fFileOpen(strPath & strCSVFileName) = True Then
'file is open
thisSelection.Copy
Application.DisplayAlerts = False
Workbooks(strCSVFileName).Activate
With Workbooks(strCSVFileName)
With Workbooks(strCSVFileName).ActiveSheet
.Range("A1").Select
Selection.End(xlDown).Select
'move down one cell
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial
Paste:=xlPasteFormulasAndNumberFormats
End With
.Save
End With
Else
'file is not open
thisSelection.Copy
Application.DisplayAlerts = False
Set newBook = Workbooks.Open(strPath & strCSVFileName)
With newBook
Set NewSheet = newBook.ActiveSheet
With NewSheet
.Range("A1").Select
If Range("A1").Value = "" Then
ActiveCell.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
Else
Selection.End(xlDown).Select
'move down one cell
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats
End If
End With
newBook.Save
newBook.Close
End With
Application.DisplayAlerts = True
ThisBook.Activate
End If
Else
'create new file
thisSelection.Copy
Set newBook = Workbooks.Add
Set NewSheet = newBook.ActiveSheet
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.DisplayAlerts = False
newBook.SaveAs Filename:=strPath & strCSVFileName, FileFormat:=xlCSV
newBook.Close
Application.DisplayAlerts = True
ThisBook.Activate
End If



PROC_EXIT:
Exit Sub
End Sub