Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tab suchen

Tab suchen
Volker
Hallo, ich möchte überprüfen, ob in einer andren Datei, sagen wir a.xls das tab xy existiert.
Kann mir da jemand helfen

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Tab suchen
12.03.2010 18:37:44
Josef

Hallo Volker,
ja, das geht.

' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Test()
  Dim a As Variant, lngIndex As Long
  Dim blnExist As Boolean
  Dim strTab As String, strFile As String
  
  strTab = "Tabelle1" 'Tabellenname
  strFile = "E:\Forum\68515.xlsm" 'Dateiname
  
  a = GetSheetNames(strFile)
  
  If IsArray(a) Then
    For lngIndex = 0 To UBound(a)
      If a(lngIndex) = strTab Then
        blnExist = True
      End If
    Next
  End If
  
  MsgBox "Das Blatt '" & strTab & "' gibt es" & IIf(blnExist, "!", " nicht!")
End Sub

Private Function GetSheetNames(ByVal File As String) As Variant
  'original by Bob Phillips, adapted by j.ehrensberger
  Dim objADO_Connection As Object, objADO_Catalog As Object, objADO_Tables As _
    Object
  Dim lngIndex As Long, intLength As Integer, intPos As Integer, intStart As _
    Integer
  Dim strConString As String, strTable As String
  Dim varTmp() As Variant
  
  If Dir(File, vbNormal) = "" Then Exit Function
  
  If Mid(File, InStrRev(File, ".") + 1) = "xls" Then
    strConString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Extended Properties=Excel 8.0;" & _
      "Data Source=" & File & ";"
  ElseIf Mid(File, InStrRev(File, ".") + 1) Like "xls?" Then
    strConString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Extended Properties=""Excel 12.0;HDR=YES"";" & _
      "Data Source=" & File & ";"
  Else
    Exit Function
  End If
  
  
  Set objADO_Connection = CreateObject("ADODB.Connection")
  objADO_Connection.Open strConString
  Set objADO_Catalog = CreateObject("ADOX.Catalog")
  Set objADO_Catalog.ActiveConnection = objADO_Connection
  
  For Each objADO_Tables In objADO_Catalog.Tables
    strTable = objADO_Tables.Name
    intLength = Len(strTable)
    intPos = 0
    intStart = 1
    'Worksheet name with embedded spaces enclosed by single quotes
    If Left(strTable, 1) = "'" And Right(strTable, 1) = "'" Then
      intPos = 1
      intStart = 2
    End If
    'Worksheet names always end in the "$" character
    If Mid$(strTable, intLength - intPos, 1) = "$" Then
      Redim Preserve varTmp(lngIndex)
      varTmp(lngIndex) = Mid$(strTable, intStart, intLength - (intStart + _
        intPos))
      lngIndex = lngIndex + 1
    End If
  Next objADO_Tables
  
  If lngIndex > 0 Then GetSheetNames = varTmp
  
  objADO_Connection.Close
  Set objADO_Catalog = Nothing
  Set objADO_Connection = Nothing
  
End Function

Gruß Sepp

Anzeige
AW: frage zum Code
12.03.2010 18:54:27
chris
Hallo Sepp,
habe eine frage zu Deinem Code.
Hoffe Du kannst Sie mir beantworten.
Die frage war ja die.
Er will prüfen ob in einer anderen Datei ein Sheet namens "xxx" existiert.
Kann er nicht einfach mit VBA die Datei öffnen und mit einer for each schleife die Sheet Namen der geöffneten Datei prüfen ?
Was macht Dein Code ?
Vielen dank für Die Antwort.
gruß Chris
P.s Weil bin ja auch noch Anfänger und das:
Set objADO_Connection = CreateObject("ADODB.Connection")
objADO_Connection.Open strConString
Set objADO_Catalog = CreateObject("ADOX.Catalog")
kenne ich zum Beispiel noch nicht vielleicht ist das ja etwas was ich auch mal brauchen könnte :)
Anzeige
AW: frage zum Code
12.03.2010 19:00:18
Josef

Hallo Chris,
natürlich könnte man die Datei öffnen um nachzusehen ob das Tabellenblatt existiert.
Der Code ist im Prinzip eine sql-Abfrage, das heißt, die Datei wird als Datenbank behandelt/geöffnet und die Tabellennamen ausgelesen.

Gruß Sepp

AW: frage zum Code
12.03.2010 19:07:44
chris
Danke !
oder meinst du in den geöffneten ...
12.03.2010 18:56:11
Josef

... Mappen, Volker,
dann wirds einfacher.

Sub Test2()
  Dim blnExist As Boolean
  Dim strTab As String, strFile As String
  
  strTab = "Tabelle1" 'Tabellenname
  strFile = "68515.xlsm" 'Dateiname
  
  blnExist = SheetExist(strTab, strFile)
  
  MsgBox "Das Blatt '" & strTab & "' gibt es" & IIf(blnExist, "", " nicht") & " in der Datei '" & strFile & "'!"
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp

Anzeige
War zu schnell beim Kopieren!
12.03.2010 19:07:07
Josef

Hallo nochmal,
hab zu hastig kopiert.

Sub Test2()
  Dim blnExist As Boolean
  Dim strTab As String, strFile As String
  
  strTab = "Tabelle1" 'Tabellenname
  strFile = "68515.xlsm" 'Dateiname
  
  blnExist = SheetExist(strTab, Workbooks(strFile))
  
  MsgBox "Das Blatt '" & strTab & "' gibt es" & IIf(blnExist, "", " nicht") & " in der Datei '" & strFile & "'!"
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function

Gruß Sepp

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige