save(append) to an excel file

[Mark Elkins]

The following code will copy(append) a range to a .csv file. I am looking for
a way to save(append) to an excel file, rather than .csv?

Sub Append2CSV()
Dim tmpCSV As String 'string to hold the CSV info
Dim f As Integer
Dim CSVFile As String, varData As Variant
Dim myRng As String
Dim myRng2 As String
Dim myRng3 As String

myRng = Application.InputBox("Enter a number")

'Const CSVFile As String = "Z:\FILES\ACCOUNTING\PAYROLL\DAILY PROGRESS
REPORTS (DPRs)\WE 5-9-10\WE 5-9-10.csv" 'replace with your filename

f = FreeFile
myRng2 = "A2:N"
myRng3 = myRng2 & myRng

varData = InputBox("Enter Date")
If Not IsDate(varData) Then MsgBox "Invalid Date": Exit Sub

CSVFile = "Z:\FILES\ACCOUNTING\PAYROLL\DAILY PROGRESS REPORTS " & _
"(DPRs)\WE " & Format(CDate(varData), "m-d-yy") & "\WE " & _
Format(CDate(varData), "m-d-yy") & ".csv"

MsgBox CSVFile

Open CSVFile For Append As #f
tmpCSV = Range2CSV(Range(myRng3))
Print #f, tmpCSV
Close #f
End Sub

Function Range2CSV(list) As String
Dim tmp As String
Dim cr As Long
Dim r As Range

If TypeName(list) = "Range" Then
cr = 1

For Each r In list.Cells
If r.Row = cr Then
If tmp = vbNullString Then
tmp = r.Value
Else
tmp = tmp & "," & r.Value
End If
Else
cr = cr + 1
If tmp = vbNullString Then
tmp = r.Value
Else
tmp = tmp & Chr(10) & r.Value
End If
End If
Next
End If

Range2CSV = tmp
End Function

Thank you,

Mark

 

[joel]

Is the file you are appending to an Excel file or a CSV file?

the simple method would be to open the csv file after you have appende
the data and then sae the file as an excel file. I think this is th
best method since you have a csv file that you are starting with.

The problem with using an excel file to append is the first time yo
run the macro you will have a csv file. then after you append data th
1st time the file you are appending will be an excel file.



Sub Append2CSV()
Dim tmpCSV As String 'string to hold the CSV info
Dim f As Integer
Dim CSVFile As String, varData As Variant
Dim myRng As String
Dim myRng2 As String
Dim myRng3 As String

myRng = Application.InputBox("Enter a number")

'Const CSVFile As String = "Z:\FILES\ACCOUNTING\PAYROLL\DAILY PROGRESS
'REPORTS (DPRs)\WE 5-9-10\WE 5-9-10.csv" 'replace with your filename

f = FreeFile
myRng2 = "A2:N"
myRng3 = myRng2 & myRng

varData = InputBox("Enter Date")
If Not IsDate(varData) Then MsgBox "Invalid Date": Exit Sub

CSVFile = "Z:\FILES\ACCOUNTING\PAYROLL\DAILY PROGRESS REPORTS " & _
"(DPRs)\WE " & Format(CDate(varData), "m-d-yy") & "\WE " & _
Format(CDate(varData), "m-d-yy") & ".csv"

MsgBox CSVFile

Open CSVFile For Append As #f
tmpCSV = Range2CSV(Range(myRng3))
Print #f, tmpCSV
Close #f

Set CSVbk = Workbooks.Open(Filename:=CSVFile)
'strip off csv extension

XLSFile = Left(CSVFile, InStrRev(CSVFile, "."))
'add xls as file extension
XLSFile = XLSFile & "xls"

CSVbk.SaveAs Filename:=XLSFile
CSVbk.Close savechanges:=False


End Sub

Function Range2CSV(list) As String
Dim tmp As String
Dim cr As Long
Dim r As Range

If TypeName(list) = "Range" Then
cr = 1

For Each r In list.Cells
If r.Row = cr Then
If tmp = vbNullString Then
tmp = r.Value
Else
tmp = tmp & "," & r.Value
End If
Else
cr = cr + 1
If tmp = vbNullString Then
tmp = r.Value
Else
tmp = tmp & Chr(10) & r.Value
End If
End If
Next
End If

Range2CSV = tmp
End Function

 

[Jacob Skaria]

Hi Mark

Try the below....

Sub Append2XLS()
Dim XLSFile As String, varData As Variant
Dim rngTemp As Range, myRng As String

myRng = Application.InputBox("Enter a number")
Set rngTemp = Range("A2:N" & myRng)

varData = InputBox("Enter Date")
If Not IsDate(varData) Then MsgBox "Invalid Date": Exit Sub

XLSFile = "Z:\FILES\ACCOUNTING\PAYROLL\DAILY PROGRESS REPORTS " & _
"(DPRs)\WE " & Format(CDate(varData), "m-d-yy") & "\WE " & _
Format(CDate(varData), "m-d-yy") & ".xls"

MsgBox XLSFile

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = Workbooks.Open(XLSFile)
lngLastRow = wb.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
rngTemp.Copy wb.Sheets("Sheet1").Range("A" & lngLastRow + 1)
wb.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Mark Elkins]

Thank you Jacob!

I manually insert a unique header in the first row (from the workbook(s) I
append from) each time I create a new workbook to append. Do have a
suggestion on how I could insert this header if it doesn’t exist, but do
nothing if does exist? Also, is there a way to create the folder\excel file
if it doesn’t exist?

Thank you again for your generous help.

-Mark