Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Add Column In Excel 2

Status
Not open for further replies.

Swi

Programmer
Joined
Feb 4, 2002
Messages
1,981
Location
US
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
 


Hi,

Could you please focus your question to the statement to which you wish this question to apply?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
SkipVought,

.Execute "SELECT * INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] FROM [" & SheetName & "$] WHERE " & SQL, num_copied

I would like to know if there is a dynamic way to export the sheet name as a seperate column is the output Excel file that I am generating from the above SQL statement. Thanks.

Swi
 
I'm not able to test this but perhaps something like (using Create as an example):
Code:
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 *[red], " & sheetname & "[/red] INTO [Excel 8.0;Database=" & OutputFile & "].[Sheet1] FROM [" & SheetName & "$] WHERE " & SQL, num_copied
        .Close
    End With
    Set conn = Nothing
End Sub
Hope this helps

Andy
---------------------------------
[green]' Signature removed for testing purposes.[/green]

 
Andy,

This seems to work although is there a way to add this column to the end of the sheet an name it so it does not get called Expr1000? Thanks.

Swi
 


Use AS to add a column alias.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
That worked great as well. Now the only issue is that this needs to be the last column in Excel.

Swi
 
Here is my code. The two columns I have added appear as columns A and B when I open the output XLS. I would like any columns added to be at the back of the last populated column instead of at the beginning.

Option Explicit
Dim i As Integer


Code:
Private Sub Command1_Click()

' Letters
CreateExcelFile "C:\11-10.xls", "C:\LETTER_1.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_1.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_2.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_2.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\LETTER_3.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\LETTER_3.XLS", "Welcome Letter", ", 'LETTER' AS [Piece Type]", "[Org ID] = '16'"

' Postcards
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_1.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_1.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_2.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] = '15'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_2.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\POSTCARD_3.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] = '16'"
AppendToExcelFile "C:\11-11.xls", "C:\POSTCARD_3.XLS", "Postcard", ", 'POSTCARD' AS [Piece Type]", "[Org ID] = '16'"

' Reminders
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder 1", ", '122255_CO_RMNDR_01' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder 1", ", '122255_CO_RMNDR_01' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '15'"
CreateExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder 1", ", '122255_CO_RMNDR_01' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '16'"
For i = 2 To 4
    AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_1.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
    AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_2.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '15'"
    AppendToExcelFile "C:\11-10.xls", "C:\REMINDER_3.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '16'"
Next
For i = 1 To 4
    AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_1.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] <> '15' AND [Org ID] <> '16'"
    AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_2.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '15'"
    AppendToExcelFile "C:\11-11.xls", "C:\REMINDER_3.XLS", "Reminder " & i, ", '122255_CO_RMNDR_0" & i & "' AS [Reminder Version], 'REMINDER' AS [Piece Type]", "[Org ID] = '16'"
Next
MsgBox "Done!", vbInformation

End Sub

Private Sub CreateExcelFile(InFile As String, OutFile As String, SheetName As String, SQL1 As String, SQL2 As String)
    If Dir$(OutFile) <> vbNullString Then Kill OutFile
    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=" & InFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
        .CursorLocation = adUseClient
        .Open
        .Execute "SELECT *" & SQL1 & " INTO [Excel 8.0;Database=" & OutFile & "].[Sheet1] FROM [" & SheetName & "$] WHERE " & SQL2, num_copied
        .Close
    End With
    Set conn = Nothing
End Sub


Private Sub AppendToExcelFile(InFile As String, OutFile As String, SheetName As String, SQL1 As String, SQL2 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=" & InFile & ";Extended Properties=""Excel 8.0;HDR=YES;"";"
        .CursorLocation = adUseClient
        .Open
        .Execute "INSERT INTO [Excel 8.0;Database=" & OutFile & "].[Sheet1] SELECT *" & SQL1 & " FROM [" & SheetName & "$] WHERE " & SQL2, num_copied
        .Close
    End With
    Set conn = Nothing
End Sub

Swi
 
It works if I actually list each field in the Excel file to select in my SQL statement. Is there a way around this?

Swi
 
BTW, thank you to everyone for your help.

Swi
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top