I have a Project at hand "Importing Excel files into a VBA" but i dont know how to go about it. Please can someone put me through. Though i tried Importing wizard but am not getting the result i wanted. Please what do u suggest.
-
-
give refrence to your VBA and you can import data from Exel to VBAOriginally posted by laparico2002 -
I do not know how to go about this either laparico2002. I did find this for you though: http://forums.microsof t.com/MSDN/ShowPost.aspx?P ostID=1123176&S iteID=1
TIP: If you try your problem/question into google, you are likely to find some answers.
Good luck!
DököllComment
-
First add refrence Microsoft Excel 9.0 Object library
then use idea from this code i think its gonna help u
Private Sub Command1_Click( )
On Error GoTo err:
Call StartExcelS
Call CreateWorkSheet S
Call PopulateWorkShe etS
Call SaveWorkSheetS
Call CloseWorkSheetS
Exit Sub
err:
MsgBox "Error Number: " & err.Number & "; " & err.Description , vbOKOnly + vbCritical
End Sub
Private Sub StartExcelS()
On Error GoTo err:
l5.Caption = "Opening Excel"
Set Excel = GetObject(, "Excel.Applicat ion") ' Create Excel Object.
'Well you have to do like this.
'Above line if I used CreateObject, 1st time it would
'work fine but the second time my program would
'hang.Well I found this the easiest way to do it.
'But you can do it another way if you like.
'By default after creating the Excel it will
'not be shown on the screen.
'I you want to show it then
'Excel.Visible = True ' Show Excel
Exit Sub
err:
Set Excel = CreateObject("E xcel.Applicatio n") 'Create Excel Object.
End Sub
Private Sub CreateWorkSheet S()
l5.Caption = "Creating Excel Worksheet"
Set ExcelWBk = Excel.Workbooks .Open(App.Path & "\dummy.xls ") 'Add this Workbook to Excel.
Set ExcelWS = ExcelWBk.Sheets (3) 'ActiveSheet ' Add this sheet to this Workbook
End Sub
Private Sub PopulateWorkShe etS()
Dim row As Integer
Dim temp As String
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyC ode <> 4 And ModeOfPayment = 1 Order By UtilityCompanyC ode", cn, adOpenKeyset, adLockOptimisti c
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.O pen "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fiel ds(4).Value, cn, adOpenKeyset, adLockOptimisti c
If rsCompanyName.R ecordCount > 0 Then
ExcelWS.Cells(r ow, 2) = rsAllInOne.Fiel ds(5).Value
ExcelWS.Cells(r ow, 3) = rsCompanyName.F ields(1).Value
ExcelWS.Cells(r ow, 4) = rsAllInOne.Fiel ds(7).Value
ExcelWS.Cells(r ow, 5) = rsAllInOne.Fiel ds(1).Value
ExcelWS.Cells(r ow, 6) = rsAllInOne.Fiel ds(12).Value
ExcelWS.Cells(r ow, 7) = rsAllInOne.Fiel ds(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.Move Next
rsCompanyName.C lose
Wend
rsAllInOne.Clos e
Set ExcelWS = ExcelWBk.Sheets (4)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyC ode <> 4 And ModeOfPayment = 2", cn, adOpenKeyset, adLockOptimisti c
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.O pen "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fiel ds(4).Value, cn, adOpenKeyset, adLockOptimisti c
If rsCompanyName.R ecordCount > 0 Then
ExcelWS.Cells(r ow, 3) = rsAllInOne.Fiel ds(5).Value
ExcelWS.Cells(r ow, 4) = rsCompanyName.F ields(1).Value
ExcelWS.Cells(r ow, 6) = rsAllInOne.Fiel ds(7).Value
ExcelWS.Cells(r ow, 7) = rsAllInOne.Fiel ds(1).Value
ExcelWS.Cells(r ow, 8) = rsAllInOne.Fiel ds(12).Value
ExcelWS.Cells(r ow, 9) = rsAllInOne.Fiel ds(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.Move Next
rsCompanyName.C lose
Wend
rsAllInOne.Clos e
Set ExcelWS = ExcelWBk.Sheets (5)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyC ode = 4 And ModeOfPayment = 1", cn, adOpenKeyset, adLockOptimisti c
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.O pen "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fiel ds(4).Value, cn, adOpenKeyset, adLockOptimisti c
If rsCompanyName.R ecordCount > 0 Then
ExcelWS.Cells(r ow, 2) = rsAllInOne.Fiel ds(5).Value
ExcelWS.Cells(r ow, 3) = rsCompanyName.F ields(1).Value
ExcelWS.Cells(r ow, 4) = rsAllInOne.Fiel ds(7).Value
ExcelWS.Cells(r ow, 5) = rsAllInOne.Fiel ds(1).Value
ExcelWS.Cells(r ow, 6) = rsAllInOne.Fiel ds(12).Value
ExcelWS.Cells(r ow, 7) = rsAllInOne.Fiel ds(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.Move Next
rsCompanyName.C lose
Wend
rsAllInOne.Clos e
Set ExcelWS = ExcelWBk.Sheets (6)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyC ode = 4 And ModeOfPayment = 2", cn, adOpenKeyset, adLockOptimisti c
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.O pen "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fiel ds(4).Value, cn, adOpenKeyset, adLockOptimisti c
If rsCompanyName.R ecordCount > 0 Then
ExcelWS.Cells(r ow, 3) = rsAllInOne.Fiel ds(5).Value
'ExcelWS.Cells( row, 4) = rsCompanyName.F ields(1).Value
ExcelWS.Cells(r ow, 5) = rsAllInOne.Fiel ds(7).Value
ExcelWS.Cells(r ow, 6) = rsAllInOne.Fiel ds(1).Value
ExcelWS.Cells(r ow, 7) = rsAllInOne.Fiel ds(12).Value
ExcelWS.Cells(r ow, 8) = rsAllInOne.Fiel ds(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.Move Next
rsCompanyName.C lose
Wend
rsAllInOne.Clos e
End Sub
Private Sub SaveWorkSheetS( )
' Save the workbook on the desktop
'I didn't had time so I have not added export feature.
'If you want to export it into another format then just
'change this line.
'e.g
'ExcelWBk.SaveA s "c:\windows\des ktop\Demo.txt", xlCSV
l5.Caption = "Saving Excel"
ExcelWBk.SaveAs App.Path & "\" & Text1.Text & Mid(Time, 7, 2) & "final.xls"
'text1.Text = ""
End Sub
Private Sub CloseWorkSheetS ()
' Close the WorkBook
ExcelWBk.Close
' Quit Excel app
Excel.Quit
l5.Caption = ""
'Text1.Text = ""
MsgBox "You can find the saved Excel Sheet at " & App.Path, vbInformation + vbOKOnly
End Sub
Originally posted by laparico2002Comment
Comment