piątek, 10 kwietnia 2009

Jak sprawdzić czy istnieje arkusz w pliku XLS

Czasem taka prosta czynność może zaoszczędzić wiele zdenerwowania zwłaszcza przed importem danych z pliku Excel.

Poniżej przedstawię proste rozwiązanie tego problemu przy pomocy funkcji w VBA. jest ona na tyle przenośna że z powodzeniem może być również zastosowana do dowolnym innym miejscu.


Function sheetexist(fileName As String, sName As String) As Boolean
Dim myExcel As Object 'Excel.Application
Dim myWorkBook As Object 'Excel.Workbook
Dim CurrentSheet As Object 'Excel.Worksheet

sheetexist = False

If Dir(fileName) = "" Then
Exit Function
End If

Set myExcel = CreateObject("Excel.Application")
Set myWorkBook = myExcel.Workbooks.Open(fileName:=fileName)

For Each CurrentSheet In myWorkBook.Worksheets
If CurrentSheet.Name = sName Then
sheetexist = True
Exit For
End If
Next

myWorkBook.Close SaveChanges:=False
myExcel.Quit

Set myWorkBook = Nothing
Set myExcel = Nothing

End Function

5 komentarzy:

  1. tylko jak wprowadzić ścieżkę do pliku np. w access-ie np c:\cośtam.xls bo z "" nie działa

    OdpowiedzUsuń
  2. if sheetexist("c:\cośtam.xls","arkusz1") then
    debug.print "w pliku jest arkusz1"
    end if

    OdpowiedzUsuń
  3. Dzięki za podpowiedź !

    OdpowiedzUsuń
  4. Function sheetexist(fileName As String, sName As String) As Boolean
    Dim myExcel As Object 'Excel.Application
    Dim myWorkBook As Object 'Excel.Workbook
    Dim CurrentSheet As Object 'Excel.Worksheet

    sheetexist = False

    If Dir(fileName) = "" Then
    Exit Function
    End If

    Set myExcel = CreateObject("Excel.Application")
    Set myWorkBook = myExcel.Workbooks.Open(fileName:=fileName)
    On Error Resume Next
    Set CurrentSheet = myWorkBook.Worksheets(sName)
    If Err.Number = 0 Then
    sheetexist = True
    Set CurrentSheet = Nothing
    Else
    Err.Clear
    End If
    On Error GoTo 0

    myWorkBook.Close SaveChanges:=False
    myExcel.Quit

    Set myWorkBook = Nothing
    Set myExcel = Nothing

    End Function

    OdpowiedzUsuń
  5. mały Edit:
    biorąc pod uwagę że na kolekcję Worksheets nie składają się np. Arkusze wykresów

    powinno się zapisać
    Set CurrentSheet = myWorkBook.Sheets(sName)

    OdpowiedzUsuń