Verify Workbook Exists From Access

Evagrius

Registered User.
Local time
Today, 16:39
Joined
Jul 10, 2010
Messages
170
Hi All,

I've tried several tactics to see if I can check if the workbook in the code exists before running the actual code - I can't seem to get it right. Can anyone please help? Thank You!

Code:
Rem OPEN WORKBOOK 
Dim XL As Excel.Application
Dim xlwkbk As Excel.Workbook
Set XL = New Excel.Application
XL.ScreenUpdating = False
Set xlwkbk = XL.Workbooks.Open("C:\MyExcel\Acid Test Ratios.xlsx")
 
The code I have below was obtained and adapted from:

Rem From http://allenbrowne.com/func-DAO.html#CreateTableDAO
Rem from http://exceltip.com/exceltips.php?view=archive_showtips&ID=433

The code below works in a manner that you may not want to implement. But it is a start. Basically, it blindly cycles through an Excel spreadsheet. But in cycling through the spread sheet, the name of each sheet is stored in the variable "strSheetName". Obviously more than what you asked for, but will give you the structure that you would need to adapt as you see fit.
Code:
    'Open Spreadsheet
    Set db = OpenDatabase(strSourceFile, False, True, "Excel 8.0;HDR=Yes;")
    ' list worksheet names
    Debug.Print "Number of sheets: "; db.TableDefs.Count
    Rem Start cycle through the spreadsheet.
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
        strSheetName = db.TableDefs(i).Name
        Rem Debug.Print strSheetName Like "[a-z]$"
        If strSheetName Like "[A-Z]$" Then
            strSQL = "Select * FROM " & "[" & strSheetName & "]"
            Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
            If rs.BOF And rs.EOF Then
                    Rem error condition
                    Debug.Print "No Records for this sheet"
                    Debug.Print "Sheet: "; db.TableDefs(i).Name
                Else
                    rs.MoveLast
                    rs.MoveFirst
                    Rem On Error GoTo ReportError
                    Do Until rs.EOF
                        bolErrorCheck = False
                        bolErrorSkip = False
                        If IsNull(rs!author) Or rs!author = "" Then bolErrorCheck = True
                        If IsNull(rs!TITLE) Or rs!TITLE = "" Then bolErrorCheck = True
                        If Not IsDate(rs!Date) Then bolErrorCheck = True
                        Rem -------------------------------------------------------------------------------
                        If IsNumeric(rs!Page) Then
                                If IsNull(rs!Page) Or rs!Page = 0 Then lonPageNUM = 9999: bolErrorCheck = True Else lonPageNUM = CLng(rs!Page)
                            Else
                                lonPageNUM = 9999
                            End If
                        If IsNull(rs!Type) Or Trim(rs!Type) = "" Then strStoryType = "???": bolErrorCheck = True Else strStoryType = rs!Type
                        Rem----------------------------------------------------------------------------------
                        If bolErrorCheck = True Then Debug.Print "Author: "; rs!author, "Title: "; rs!TITLE, "Page: "; lonPageNUM, "Type: "; rs!Type, "Date: "; IIf(IsDate(rs!Date), rs!Date, "Date Error")
                        If IsNull(rs!author) Or Trim(rs!author) = "" Then bolErrorSkip = True
                        If IsNull(rs!TITLE) Or Trim(rs!TITLE) = "" Then bolErrorSkip = True
                        imrs.AddNew
                            imrs!author = rs!author
                            imrs!TITLE = rs!TITLE
                            imrs!Date = IIf(IsDate(rs!Date), rs!Date, #1/1/1800#)
                            imrs!Page = lonPageNUM
                            imrs!Type = strStoryType
                        imrs.Update
                        bolErrorCheck = False
                        bolErrorSkip = False
                        rs.MoveNext
                    Loop
                End If
            End If
    Next i
    Rem End Spreadsheet Cycle
.
 
Last edited:
Thanks Steve - it looks a bit complex but I'll see what I can learn from it. Thanks!
 
Ok. I had a chance to strip this down to a bare minimum. All it does is print the name of each sheet in the immediate window. I hope that this helps.

It has occurred to me that I may be answering the wrong question. Did you really want to know whether the workbook file itself exists? Or where you after the name of the individual sheets. See the File Exists function at the bottom of this post.

Code:
Option Compare Database
Option Explicit
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strProjectPath As String
Dim strSourceFile As String
Dim strSheetName As String
Dim i As Integer

Sub CreateTableFromXL_DAOVersion()
Rem Creates an Access table of data from the spreadsheet without changes.
Rem From http://allenbrowne.com/func-DAO.html#CreateTableDAO
Rem from http://exceltip.com/exceltips.php?view=archive_showtips&ID=433
Rem -----------------------------------------------------------------------------------------------------------
    strProjectPath = CurrentProject.Path    
    Rem Change the source file below as required.
    Rem enter the name of the Excel Spreadsheet
    strSourceFile = strProjectPath & "\FSFAZ96.xls"
    Rem --------------------------------------------
    Set db = OpenDatabase(strSourceFile, False, True, "Excel 8.0;HDR=Yes;")
    Rem --------------------------------------------
    Rem List Worksheet Names
    Debug.Print "Number of sheets: "; db.TableDefs.Count
    Rem Start cycle through the spreadsheet.
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
        strSheetName = db.TableDefs(i).Name
    Next i
    Rem End Spreadsheet Cycle
    Rem -----------------------------------------------
    Rem Clean Up
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Exit Sub
End Sub

File exists function
Code:
Private Sub Form_Current()
.....
If FileExists(strDirectoryPath & Me.ImageLocation) Then
          Me.CoverImage.Picture = strDirectoryPath & Me.ImageLocation
      Else
           MSG1 = "Link to the Picture is NOT valid. Picture dialog box will now be opened."
            MSGTITLE = "MISSING PICTURE"
            MsgBox MSG1, vbOKOnly, MSGTITLE
            Call Command20_Click
       End If        
......
End Sub

Code:
Function FileExists(filespec As String) As Boolean
    Rem From Lagbolt
    Rem [url]http://www.access-programmers.co.uk/forums/showpost.php?p=630791&postcount=4[/url]
    FileExists = CreateObject("Scripting.FileSystemObject").FileExists(filespec)
End Function
 
Last edited:
If all you want to know is does the fiel exist in the expected location then use

Code:
If Dir(("C:\MyExcel\Acid Test Ratios.xlsx") <> "" then
   ....Exists
Else
   ....Missing
End If
 

Users who are viewing this thread

Back
Top Bottom