[VBA] GetDataClosedWB

[jules]

Hallo, ich mal wieder

Folgende Function:

Code:

Public Function GetDataClosedWB(SourcePath As String, _
   SourceFile As String, sourceSheet As String, _
       SourceRange As String, TargetRange As Range) As Boolean

   Dim strQuelle       As String
   Dim Zeilen          As Long
   Dim Spalten         As Byte
 
   On Error GoTo InvalidInput

   strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
   Zeilen = Range(SourceRange).Rows.Count
   Spalten = Range(SourceRange).Columns.Count
       With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
           .Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
       .Value = .Value

    End With
   GetDataClosedWB = True
   Exit Function
   
InvalidInput:
       GetDataClosedWB = False
       MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
     
End Function


Sub test()
..

If GetDataClosedWB(Pfad, _
            Dateiname, _
            Blatt, _
            Zellen, _
            Ziel) Then
    End If
End Sub

Wie kann ich einen Test einbauen, ob das SourceSheet in der externen Datei vorhanden ist?

Ist es nämlich nicht vorhanden, bekomme ich die Aufforderung in Excel ein Tabellenblatt auszusuchen. Da dieses aber dann in der Datei nicht vorhanden ist, klicke ich auf Abbrechen und bekomme #BEZUG! - Das würde ich gerne durch die Abfrage vorher verhindern.

Grüße

[Fennek]

Hallo,

ungeprüft:

Code:

if [not(isref(Total!a1))] then

Vor dem Sheet-Namen (hier: Total) muss noch das Workbook eingetragen werden.

mfg

[jules]

puhh.. 

wo genau meinst?
Also auf anhieb klappt es nicht.. 

[Fennek]

In einem kleinen Test mit LO ergab das WAHR:

Code:

=ISTBEZUG('file:///C:/Users/User/AppData/Local/Temp/133677.xlsx'#$Tabelle1.C7)

Wenn ich deinen gezeigten Code richtig verstanden habe, setzt du die Adresse des geschl. Workbooks zusammen. In der Formel (=ISTBEZUG) bzw VBA [isref()] wird die Existenz geprüft.

[jules]

Das ist richtig. Geschieht in der Function hier:

strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)

Allerdings verstehe ich noch nicht ganz wo ich demnach:

If [not(isref(sourceSheet))] Then

einbringen soll....

[Fennek]

ungeprüft !!!!!

Ein Prüfung, ob das SHEET existiert:

Code:

Public Function GetDataClosedWB(SourcePath As String, _
   SourceFile As String, sourceSheet As String) As Boolean

   strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!A1"
    
    GetDataClosedWB = [isref(strQuelle)]

End Function

[jules]

Ich verstehe langsaml nur noch Bahnhof .. 

    GetDataClosedWB = [isref(strQuelle)]

erledigt rein gar nichts :(

[Steffl]

Hallo,

ungetestet

Code:

Private Function WorkSheetExists(SourceFile As String, sName As String) As Boolean
On Error GoTo notfound:
   WorkSheetExists = Not Workbooks(SourceFile).Worksheets(sName) Is Nothing
notfound:
End Function
Public Function GetDataClosedWB(SourcePath As String, _
   SourceFile As String, sourceSheet As String, _
       SourceRange As String, TargetRange As Range) As Boolean

   Dim strQuelle       As String
   Dim Zeilen          As Long
   Dim Spalten         As Byte
  
   If Not WorkSheetExists(SourceFile, sourceSheet) Then MsgBox "Tabellenblatt nicht vorhanden": Exit Function
  
   On Error GoTo InvalidInput

   strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
   Zeilen = Range(SourceRange).Rows.Count
   Spalten = Range(SourceRange).Columns.Count
       With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
           .Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
       .Value = .Value

    End With
   GetDataClosedWB = True
   Exit Function
  
InvalidInput:
       GetDataClosedWB = False
       MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
    
End Function

[jules]

hmmm.

leider noch nicht.
Er erkennt GAR KEIN Blatt..

[Case]

Hallo, :19:

so: :21:

Code:

Option Explicit
Sub Main()
    Const strPath As String = "C:\Temp\"
    Const strFile As String = "Daten.xlsx"
    Const strSheetName As String = "Tabelle1"
    Const strRange As String = "A2:C4"
    Const strDestination As String = "B2"
    If ADOSheet(strPath & strFile, strSheetName) = True Then
        If GetDataClosedWB(strPath, strFile, strSheetName, strRange, Range(strDestination)) Then
            MsgBox "OK!"
        Else
            MsgBox "MIST!"
        End If
    Else
        MsgBox "Sheet nicht vorhanden!"
    End If
End Sub
Private Function ADOSheet(ByVal strFileName As String, strSheet As String) As Boolean
    Dim objConn As Object
    Dim objCat As Object
    Dim objTab As Object
    On Error GoTo Fin
    Set objConn = CreateObject("ADODB.Connection")
    With objConn
        .CursorLocation = 3
        .Provider = "Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" & "Data Source=" & strFileName & ";"
        .Open
    End With
    Set objCat = CreateObject("ADOX.Catalog")
    Set objCat.ActiveConnection = objConn
    For Each objTab In objCat.Tables
        If objTab.Name = strSheet & "$" Then
            ADOSheet = True: Exit Function
        Else
            ADOSheet = False: Exit Function
        End If
    Next objTab
Fin:
    Set objCat = Nothing
    If Not objConn Is Nothing Then
    If objConn.State = 1 Then objConn.Close
    End If
    Set objConn = Nothing
End Function
Public Function GetDataClosedWB(SourcePath As String, _
   SourceFile As String, sourceSheet As String, _
       SourceRange As String, TargetRange As Range) As Boolean

   Dim strQuelle       As String
   Dim Zeilen          As Long
   Dim Spalten         As Byte
 
   On Error GoTo InvalidInput

   strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
   Zeilen = Range(SourceRange).Rows.Count
   Spalten = Range(SourceRange).Columns.Count
       With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
           .Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
       .Value = .Value

    End With
   GetDataClosedWB = True
   Exit Function
   
InvalidInput:
       GetDataClosedWB = False
       MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
     
End Function