Microsoft Office Tutorials and References
In Depth Information
Creating a Contacts Database
Option Explicit¶
' * * * * *¶
'Set database file name and table name¶
Const strFileName As String = "C:\MyContactsDatabase.mdb"¶
Const tblName As String = "tblContacts"¶
' * * * * *¶
Public Sub CreateContactsDatabase()¶
'Outlook Application Objects declaration¶
Dim objApp As Outlook.Application¶
Dim objNS As Outlook.NameSpace¶
Dim objFolder As Outlook.MAPIFolder¶
Dim objContact As Object¶
'Database file properties¶
Dim blnFileExists As Boolean¶
Dim objConn As Object¶
Dim objSchema As Object¶
Dim i As Integer 'Counter¶
On Error GoTo ErrHandler¶
'Verify if database file exists¶
If Dir(strFileName, vbNormal) <> "" Then¶
If MsgBox(strFileName & " is an existing file." & _¶
vbCrLf & "Do you want to update database?", _¶
vbYesNo + vbQuestion, _¶
"Update Database") = vbYes Then¶
'Use existing database to update¶
blnFileExists = True¶
'Delete existing database¶
Kill strFileName¶
End If¶
End If¶
If Not blnFileExists Then¶
'Create database file¶
Call CreateNewAccessDatabase(strFileName)¶
End If¶
'Create database connection object¶
Set objConn = CreateObject("ADODB.Connection")¶
objConn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & _¶
"DATA SOURCE=" & strFileName & ";"¶
'Search for the table in database¶
'in case it already exists¶
'adSchemaTables = 20¶
Set objSchema = objConn.OpenSchema(20)¶
Do Until objSchema.EOF¶
If objSchema.Fields("TABLE_NAME") = tblName Then¶
'If table is found then skip CreateTable step¶
GoTo SaveContacts¶
End If¶
Search JabSto ::

Custom Search