I'm trying to create a new table with a VBA macro in Access 2010 to store some output and I am unable to do the basics of just creating said empty table below is the relevant code:
Dim dbs As DAO.Database
Dim emptyTdf As DAO.TableDef
Dim rs, emptyRs As DAO.Recordset
Dim fld, emptyFld As DAO.Field
Dim fldnm As String
Dim fldv As Variant
Dim isEmptyField As Boolean
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("AP")
Set emptyTdf = dbs.CreateTableDef("AP_Empty")
Set emptyFld = emptyTdf.CreateField("HID", dbText, 255)
dbs.TableDefs.Append emptyTdf
The last line sets off the run-time error. I've followed a few tutorials online using the DAO method to create tables and my code doesn't deviate, so I guess it is a syntactical gotcha that I've stumbled on.
You need to append your field to the TableDef before appending the TableDef itself:
Dim dbs As DAO.Database
Dim emptyTdf As DAO.TableDef
Dim rs, emptyRs As DAO.Recordset
Dim fld, emptyFld As DAO.Field
Dim fldnm As String
Dim fldv As Variant
Dim isEmptyField As Boolean
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("AP")
Set emptyTdf = dbs.CreateTableDef("AP_Empty")
Set emptyFld = emptyTdf.CreateField("HID", dbText, 255)
'Append your created field.
emptyTdf.Fields.Append emptyFld
dbs.TableDefs.Append emptyTdf
'Just so your collections and the db window is refreshed.
dbs.TableDefs.Refresh
Application.RefreshDatabaseWindow
Related
I am using this code to download certain outlook mail fields into access. This works well however the code is keep on downloading duplicate mails. Is there a way to check for existing records and download records which are not in the table? Your answers would help a lot in my project
Private Sub getml()
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim inbox As Outlook.MAPIFolder
Dim inboxItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
For Each Mailobject In inboxItems
With rst
.AddNew
!task= Mailobject.UserProperties.Find("taskID")
!tsktml= Mailobject.UserProperties.Find("timeline")
.Update
Mailobject.UnRead = False
End With
End If
Next
Set OlApp = Nothing
Set inbox = Nothing
Set inboxItems = Nothing
Set Mailobject = Nothi
End Sub
I am assuming that TaskID is a numeric unique identifier for tasks, not that familiar with Outlook objects. If so, you can use the following code to first check the task hasn't been imported already.
Private Sub getml()
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim inbox As Outlook.MAPIFolder
Dim inboxItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
For Each Mailobject In inboxItems
With rst
.FindFirst "task =""" & Mailobject.UserProperties.Find("taskID") & """"
If .NoMatch
.AddNew
!task= Mailobject.UserProperties.Find("taskID")
!tsktml= Mailobject.UserProperties.Find("timeline")
.Update
Mailobject.UnRead = False
End If
End With
End If
Next
Set OlApp = Nothing
Set inbox = Nothing
Set inboxItems = Nothing
Set Mailobject = Nothing
End Sub
This is my code:
Private Sub Command36_Click()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim qdef As DAO.QueryDefs
Set dbs = CurrentDb
Set qdef = dbs.QueryDefs("qryGetDecisionFieldOfSelectedRecord")
Set rs = qdef.OpenRecordset
If rs.RecordCount > 0 Then
DoCmd.OpenReport "rptApplicationDeclinedLetter", acViewPreview, "qryApplicationLetter"
End If
End Sub
The compile error is triggered at Set rs = qdef.OpenRecordSet. Apologies if this is too obvious.
Correct this to:
Dim qdef As DAO.QueryDef
I wrote simple code to insert a record in a test data table. Followed the MSDN example but cannot get past the compile error. I have tried it with the recordset and with the table name alone. Same error.
Private Sub cmdCommitChg_Click()
'this is my tester environment
Dim ztemp1, ztemp2, ztemp3 As String 'these are dummy data to append to the table
Dim tblInsert As String
Dim dbsDonors As DAO.Database
Dim rcdTempTester As DAO.Recordset
Set rcdTempTester = dbsDonors.OpenRecordset("tblTempTester")
ztemp1 = "TempId"
ztemp2 = "TempEntity"
ztemp3 = "tempName"
INSERT INTO rcdTempTester!tblTempTester (id_members, id_entity, member_Name) VALUES (ztemp1, ztemp2, ztemp3)
End Sub
You are mixing VBA and SQL. Do this:
Private Sub cmdCommitChg_Click()
'this is my tester environment
Dim ztemp1 As String
Dim ztemp2 As String
Dim ztemp3 As String
Dim tblInsert As String
Dim dbsDonors As DAO.Database
Dim rcdTempTester As DAO.Recordset
ztemp1 = "TempId"
ztemp2 = "TempEntity"
ztemp3 = "tempName"
Set rcdTempTester = dbsDonors.OpenRecordset("tblTempTester")
rcdTempTester.AddNew
rcdTempTester(ztemp1).Value = <some id>
rcdTempTester(ztemp2).Value = <some entity>
rcdTempTester(ztemp3).Value = <some name>
rcdTempTester.Update
rcdTempTester.Close
Set rcdTempTester = Nothing
Set dbsDonors = Nothing
End Sub
I started over and now things are working. Attached is the simple code to add a record (and it works).
Private Sub cmdAddNew_Click()
Dim dbsDonors As DAO.Database
Dim rstTester As DAO.Recordset
Dim zBEN As String
zBEN = "zip1"
Set dbsDonors = CurrentDb
Set rstTester = dbsDonors.OpenRecordset("tblTester")
rstTester.AddNew
rstTester!id_members = "newData"
rstTester.Update
End Sub
I'm trying to write query/table contents from access to excel using vba. Currently my code is working to open new workbook every time and write the contents instead i need to specify the path of only one workbook to write. How do i specify the path in the code
My Access VBA
Function WriteToExcel()
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'*************************************************
'First stage is to take the first query and place it
'On sheet1
'*************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM query1"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set ws = CreateObject("Excel.Application")
With ws
.Workbooks.Add
.Visible = True
End With
ws.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:Q").EntireColumn.AutoFit
rst.Close
End Function
I think there is a little confusion because of your variable prefixes. I've taken the liberty of amending your prefixes and answered the problem. You need Workbooks.Open(<<filename goes here>>) in place of Workbooks.Add. So try this code (untested as I do not have Access). Lastly there are other ways to populate Excel with data from Access, like a DataQuery. You might like to play with Excel GUI to investigate.
Function WriteToExcel()
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim appXL As Excel.Application
Dim wb As Excel.Workbook
Dim wsSheet1 As Excel.Worksheet
Dim i As Long
'*************************************************
'First stage is to take the first query and place it
'On sheet1
'*************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM query1"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set appXL = CreateObject("Excel.Application")
With appXL
'Set wb = .Workbooks.Add '<--- to create a new workbook
Set wb = .Workbooks.Open("c:\temp\Myworkbook.xlsx") '<--- to open an exisiting workbook
.Visible = True
End With
Set wsSheet1 = wb.Sheets("sheet1")
wsSheet1.Select
For i = 0 To rst.Fields.Count - 1
wsSheet1.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
wsSheet1.Range("a2").CopyFromRecordset rst
wsSheet1.Columns("A:Q").EntireColumn.AutoFit
rst.Close
End Function
Is there a way to programmatically convert an Access 2010 ACCDB file to an Access 95/97 MDB file?
Here are some notes. I do not have an old version to play around with, so I do not know if you can import more than you can export:
Dim ws As Workspace
Dim db As Object
Dim tdf As TableDef
Dim qdf As QueryDef
Dim dbExp As Database
Dim acApp As New Access.Application
acApp.OpenCurrentDatabase "z:\docs\demo.accdb"
Set dbExp = acApp.CurrentDb
Set ws = DBEngine.Workspaces(0)
FName = "z:\docs\oldver95.mdb"
''Access 95
Set db = ws.CreateDatabase(FName, dbLangGeneral, dbVersion30)
''You can only export tables and a limited range of datatypes
For Each tdf In dbExp.TableDefs
If Left(tdf.Name, 4) <> "Msys" Then
acApp.DoCmd.TransferDatabase acExport, "Microsoft Access", _
FName, acTable, tdf.Name, tdf.Name
End If
Next
See http://msdn.microsoft.com/en-us/library/office/bb243161(v=office.12).aspx
A few notes using VBScript to demonstrate using the engine:
Dim objEngine
Dim objWS
Dim objDB
Dim db: db = "z:\docs\oldver95.mdb"
Set objEngine = CreateObject("DAO.DBEngine.36")
Set objDB = objEngine.OpenDatabase(db)
strSQL="SELECT * FROM Table1"
objDB.CreateQueryDef "Query1", strSQL