PDA

View Full Version : Need help on loop



Ronnie76
08-04-2008, 07:18 AM
Hello,

Pleasee take a look at the code beneath, it is written for Access and then I take a 'D-Tour' to Excel:


Dim dbs As Database
Dim rs As DAO.Recordset
Dim varItm As Variant

strDBName = "c:\invoicedata.mdb"
Set dbs = OpenDatabase(strDBName)
Set rst = CurrentDb.OpenRecordset("SELECT * FROM INVOICES where invoiceNumber = '" & invoiceNumber & "'")


'Set MyXLApp = New Excel.Application
'MyXLApp.Workbooks.Open Filename:="c:\test.xls"

Do While Not rst.EOF
MsgBox rst!Field1InvoiceNumber
MsgBox rst!Field2InvoiceRule
MsgBox rst!Field3InvoiceRuleTotal
rst.MoveNext
Loop

'MyXLApp.Quit 'Exit Excel
'Set MyXLApp = Nothing 'Remove object from memory

The problem:
I want the data in the loop to be placed in the Excel worksheet but I don't have no idea how.....
I supposte I have to take rst.size somehow and with this info I cant build a loop and wirte away the data from a specific cell in the Excel worksheet.

Does anyone has an example for me for this ?

Thanks !!

nepotist
08-04-2008, 07:35 AM
I might not be of a great help as i am new to VBA.... but i here is my thought

why dont you create a tabel of your deisred result within access and then export is in excel...

This is just a thought.. If this can be done can some one throw light on this (how to do it?)

RonMcK
08-04-2008, 08:09 AM
Ronnie,

I'm rusty on Access but perhaps the following will work for you. I borrowed an idea from mdmackillop and built an array as the code reads through the Access DB. Once that's done, it then opens Excel, and your file (test.xls) and loops through the rows of the table writing out rows in the worksheet.

Sub Access2Excel()
Dim MyXLApp As Object
Dim myObj
Dim myWB
Dim mySh
Dim i As Long
Dim arr()
Dim ArrSize As Long
Dim ArrIncrement As Long
ArrIncrement = 100
ArrSize = ArrIncrement
ReDim arr(ArrSize, 3)
Dim FilePathFileName As String

Dim dbs As Database
Dim rs As DAO.Recordset
Dim varItm As Variant

strDBName = "c:\invoicedata.mdb"
Set dbs = OpenDatabase(strDBName)
Set rst = CurrentDb.OpenRecordset("SELECT * FROM INVOICES where invoiceNumber = '" & invoiceNumber & "'")
i = 1
While Not rst.EOF
i = i + 1
MsgBox rst!Field1InvoiceNumber
MsgBox rst!Field2Invoicerule
MsgBox rst!Field3InvoiceRuleTotal

arr(i, 1) = rst!Field1InvoiceNumber
arr(i, 2) = rst!Field2Invoicerule
arr(i, 3) = rst!Field3InvoiceRuleTotal

rst.MoveNext

If i = ArrSize Then
ArrSize = ArrSize + ArrIncrement
ReDim Preserve arr(ArrSize)
End If
Wend
ReDim Preserve arr(i, 3)

Set myObj = CreateObject("New Excel.Application")
Set myWB = myObj.workbooks.Open("c:\test.xls")
Set mySh = myWB.sheets("Sheet1")
intRowCount = 1
For i = 1 To UBound(arr)
mySh.Cells(i, 1) = arr(i, 1)
mySh.Cells(i, 2) = arr(i, 2)
mySh.Cells(i, 3) = arr(i, 3)
myWB.Close True
myObj.Quit
Set mySh = Nothing
Set myWB = Nothing 'Remove object from memory
Set myObj = Nothing

End Sub
HTH,

Bob Phillips
08-04-2008, 08:17 AM
Set MyXLApp = New Excel.Application
Set myWb = MyXLApp.Workbooks.Open(Filename:="c:\test.xls")
Set myWs = myWb.Worksheets(1)
myWs.Range("A1").CopyFromRecordset rst
MyWb.Save

Set myWs = Nothing
Set myWb = Nothing
MyXLApp.Quit 'Exit Excel
Set MyXLApp = Nothing 'Remove object from memoryEnd Sub

Ronnie76
08-05-2008, 07:10 AM
Thank you all so much for the help provided !
XLD's answer helped me out, good job it would have taken me a long time figuring that out.
I owe you one :beerchug: