Tuesday, March 01, 2005

Searching for that piece of VBA code for access-Excel issues???

****This Sub writes the values form an XL sheet to an access table.****

Private Sub Command16_Click()

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
'xlx.Visible = True
Set xlw = xlx.Workbooks.Open("E:\csvfiles\test.xls")
Set xls = xlw.Worksheets(1)
Set xlc = xls.Range("A2")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("testtable", dbOpenDynaset, dbAppendOnly)
Do While xlc.Value <> ""
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).Value = xlc.Offset(0, lngColumn).Value
Next lngColumn
rst.Update
Set xlc = xlc.Offset(1, 0)
Loop
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

MsgBox "Data Loaded"








'Dim db1 As DAO.Database
'Dim rs1 As DAO.Recordset
'Dim qdf1 As QueryDef
'Set db1 = CurrentDb()
'Set qdf1 = db1.CreateQueryDef("")
'qdf1.SQL = "SELECT * INTO testtable FROM [Excel 8.0;database=E:\csvfiles\test.xls;].[Sheet2$]"

'Dim SQL1 As String
'Dim qdef As QueryDef

'SQL1 = "SELECT * INTO testtable FROM [Excel 8.0;database=E:\csvfiles\test.xls;].[Sheet2$]"
'CurrentDb.Execute "qdf1"

'Set rs1 = qdf1.OpenRecordset()

'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "testtable", "E:\csvfiles\test.xls", True, "myrange2"
End Sub

****This Sub writes the values form an access table to an XL sheet.****

Private Sub Command17_Click()
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim db As Database, rs As Recordset
Dim intColIndex As Integer
Dim TargetRange As Range
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("E:\csvfiles\test.xls", ReadOnly:=False)
Set xls = xlw.Worksheets(2)
Set TargetRange = xls.Range("A1")
Set TargetRange = TargetRange.Cells(1, 1)
Set db = CurrentDb()
Set rs = db.OpenRecordset("testtable", dbOpenTable) ' all records
'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
" WHERE " & FieldName & _
" = 'MyCriteria'", dbReadOnly) ' filter records
' write field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
' write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

No comments: