Check if access database exists 1

[brownfox]

I have code that creates a database, then creates a table on the database:

Private Sub cmdOK_Click()
Const dbVersion10 = 1
Const dbVersion11 = 8
Const dbVersion20 = 16
Const dbVersion30 = 32
Const dbVersion40 = 64
  Dim Engine
  Set Engine = CreateObject("DAO.DBEngine.36")
  Engine.CreateDatabase App.Path & "\tournaments.mdb", ";LANGID=0x0409;CP=1252;COUNTRY=0", dbVersion40
    Dim strMessage
    Dim theFile
    strMessage = "Drive: " & drvDialog.Drive
    strMessage = strMessage & vbCr & "Path: " & dirDialog.Path
    strMessage = strMessage & vbCr & "Filename: " & filDialog.FileName
    strMessage = strMessage & vbCr & "The lot: "
    If Right(filDialog.Path, 1) = "\" Then
        strMessage = strMessage & filDialog.Path & filDialog.FileName
    Else
        strMessage = strMessage & filDialog.Path & "\" & filDialog.FileName
    End If
    ' MsgBox strMessage
    If Right(filDialog.Path, 1) = "\" Then
       theFile = filDialog.Path & filDialog.FileName
    Else
        theFile = filDialog.Path & "\" & filDialog.FileName
    End If
Dim excel_app As Object
Dim excel_sheet As Object
Dim max_row As Integer
Dim max_col As Integer
Dim row As Integer
Dim col As Integer
Dim statement As String
Dim new_value As String
Dim theDate As Variant
Dim thisYear As Integer
thisYear = Format(Now, "yyyy")
Dim a As Integer
Dim ageGroup As String
    Set excel_sheet = Nothing
    Set excel_app = Nothing
    Screen.MousePointer = vbHourglass
    DoEvents

    ' Create the Excel application.
    Set excel_app = CreateObject("Excel.Application")

    ' Uncomment this line to make Excel visible.
    'excel_app.Visible = True

    ' Open the Excel spreadsheet.
    excel_app.Workbooks.Open FileName:=theFile

    ' Check for later versions.
    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If

    ' Get the last used row and column.
    max_row = excel_sheet.UsedRange.Rows.Count
    max_col = excel_sheet.UsedRange.Columns.Count

    ' Open the Access database.
    Set conn = New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & filDialog.Path & "\tournaments.mdb" & ";" & "Persist Security Info=False"
    conn.Open

    ' Loop through the Excel spreadsheet rows,
    ' skipping the first row which contains
    ' the column headers.
    statement = "create table players (FirstName text(50),LastName text(50),Age text(50),School text(50),County text(50),Grade number)"
        conn.Execute statement, , adCmdText
    For row = 1 To max_row
         'Compose an INSERT statement.
        statement = "INSERT INTO players VALUES ("
        For col = 1 To max_col
            If col > 1 Then statement = statement & ","
            new_value = Trim$(excel_sheet.Cells(row, col).Value)
            If col = 3 Then
                theDate = Split(new_value, ".")
                For a = 0 To UBound(theDate)
                If theDate(1) < 9 Then
                ageGroup = "U" & (thisYear - theDate(2) + 1)
                MsgBox ageGroup
                'statement = statement & "'" & ageGroup & "'"
                ElseIf theDate(1) >= 9 Then
                ageGroup = "U" & thisYear - (theDate(2))
                'statement = statement & "'" & ageGroup & "'"
                End If
                Next a
                statement = statement & "'" & ageGroup & "'"
                ElseIf col = 6 Then
                statement = statement & new_value
            Else
                statement = statement & "'" & new_value & "'"
            End If
        Next col
        statement = statement & ")"
        ' Execute the INSERT statement.
        conn.Execute statement, , adCmdText
    Next row

    ' Close the database.
    conn.Close
    Set conn = Nothing

    ' Comment the Close and Quit lines to keep
    ' Excel running so you can see it.

    ' Close the workbook saving changes.
    excel_app.ActiveWorkbook.Close True
    excel_app.Quit

    Set excel_sheet = Nothing
    Set excel_app = Nothing

    Screen.MousePointer = vbDefault
    MsgBox "Copied " & Format$(max_row - 1) & " values."

       End Sub

What I want to do is test to see if the database exists first before I try to create it. Does any one know how I could do this? Thanks in advance

 

[strongm]

One method might be to investigate the Dir$ function

 

[Swi]

faq222-3657

Swi

 

[brownfox]

Thanks, I have got this from the FAQ:

Private Sub cmdOK_Click()
If FileExistsDIR(App.Path & "\myDatabase.mdb") = False Then

Const dbVersion10 = 1
Const dbVersion11 = 8
Const dbVersion20 = 16
Const dbVersion30 = 32
Const dbVersion40 = 64
' Sub CreateNewMDB(FileName, Format)
  Dim Engine
  Set Engine = CreateObject("DAO.DBEngine.36")
  Engine.CreateDatabase App.Path & "\tournaments.mdb", ";LANGID=0x0409;CP=1252;COUNTRY=0", dbVersion40
End If
etc...
End Sub
--------------------------------------------------------
 Function FileExistsDIR(sFile As String) As Boolean
    FileExistsDIR = True
    If Dir$(sFile) = vbNullString Then
    FileExistsDIR = False
    End If
End Function

 

[WindDrinker]

include in references:
Microsoft Scripting Runtime


Public Function DoesFolderExist(FolderSpec As String) As Boolean

If fso.FolderExists(FolderSpec) = False Then
'MsgBox FolderSpec
'create the folder
fso.CreateFolder (FolderSpec)
End If


End Function

Public Function DoesFileExist(FLName As String) As Boolean

If fso.FileExists(FLName) Then
' fso.DeleteFile (FLName) (or just return a value)
End If

End Function