Is there a way to integrate a column with the sheet name that I am reading from the spreadsheet at the same time I am selecting the records to write to another spreadsheet? Thanks.
Option Explicit
Dim i As Integer
Private Sub Command1_Click()
' Letters
CreateExcelFile "C:\11-10.xls", "C:\LETTER_1.XLS", "Welcome Letter", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_1.XLS", "Welcome Letter", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_2.XLS", "Welcome Letter", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_2.XLS", "Welcome Letter", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_3.XLS", "Welcome Letter", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_3.XLS", "Welcome Letter", "[Org ID] = '16'"
' Postcards
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_1.XLS", "Postcard", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_1.XLS", "Postcard", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_2.XLS", "Postcard", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_2.XLS", "Postcard", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_3.XLS", "Postcard", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_3.XLS", "Postcard", "[Org ID] = '16'"
' Reminders
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder 1", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder 1", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder 1", "[Org ID] = '16'"
For i = 2 To 4
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder " & i, "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder " & i, "[Org ID] = '15'"
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder " & i, "[Org ID] = '16'"
Next
For i = 1 To 4
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_1.XLS", "Reminder " & i, "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_2.XLS", "Reminder " & i, "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_3.XLS", "Reminder " & i, "[Org ID] = '16'"
Next
MsgBox "Done!", vbInformation
End Sub
Private Sub CreateExcelFile(InputFile As String, OutputFile As String, SheetName As String, SQL As String)
If Dir$(OutputFile) <> vbNullString Then Kill OutputFile
Dim conn As ADODB.Connection
Dim num_copied As Long
Set conn = New ADODB.Connection
With conn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & InputFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
.CursorLocation = adUseClient
.Open
.Execute "SELECT * INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] FROM [" & SheetName & "$] WHERE " & SQL, num_copied
.Close
End With
Set conn = Nothing
End Sub
Private Sub AppendToExcelFile(InputFile As String, OutputFile As String, SheetName As String, SQL As String)
Dim conn As ADODB.Connection
Dim num_copied As Long
Set conn = New ADODB.Connection
With conn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & InputFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
.CursorLocation = adUseClient
.Open
.Execute "INSERT INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] SELECT * FROM [" & SheetName & "$] WHERE " & SQL, num_copied
.Close
End With
Set conn = Nothing
End Sub
Swi
Option Explicit
Dim i As Integer
Private Sub Command1_Click()
' Letters
CreateExcelFile "C:\11-10.xls", "C:\LETTER_1.XLS", "Welcome Letter", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_1.XLS", "Welcome Letter", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_2.XLS", "Welcome Letter", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_2.XLS", "Welcome Letter", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_3.XLS", "Welcome Letter", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_3.XLS", "Welcome Letter", "[Org ID] = '16'"
' Postcards
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_1.XLS", "Postcard", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_1.XLS", "Postcard", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_2.XLS", "Postcard", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_2.XLS", "Postcard", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_3.XLS", "Postcard", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_3.XLS", "Postcard", "[Org ID] = '16'"
' Reminders
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder 1", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder 1", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder 1", "[Org ID] = '16'"
For i = 2 To 4
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder " & i, "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder " & i, "[Org ID] = '15'"
AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder " & i, "[Org ID] = '16'"
Next
For i = 1 To 4
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_1.XLS", "Reminder " & i, "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_2.XLS", "Reminder " & i, "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_3.XLS", "Reminder " & i, "[Org ID] = '16'"
Next
MsgBox "Done!", vbInformation
End Sub
Private Sub CreateExcelFile(InputFile As String, OutputFile As String, SheetName As String, SQL As String)
If Dir$(OutputFile) <> vbNullString Then Kill OutputFile
Dim conn As ADODB.Connection
Dim num_copied As Long
Set conn = New ADODB.Connection
With conn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & InputFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
.CursorLocation = adUseClient
.Open
.Execute "SELECT * INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] FROM [" & SheetName & "$] WHERE " & SQL, num_copied
.Close
End With
Set conn = Nothing
End Sub
Private Sub AppendToExcelFile(InputFile As String, OutputFile As String, SheetName As String, SQL As String)
Dim conn As ADODB.Connection
Dim num_copied As Long
Set conn = New ADODB.Connection
With conn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & InputFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
.CursorLocation = adUseClient
.Open
.Execute "INSERT INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] SELECT * FROM [" & SheetName & "$] WHERE " & SQL, num_copied
.Close
End With
Set conn = Nothing
End Sub
Swi