Abfrage überspringen

Hallo im Forum,

ich habe ein Makro welches in xls*-Dateien den Inhalt nach einem Wort durchsucht. Zum Durchsuchen wird die Datei geöffnet.
Nun gibt es, warum auch immer, Dateien wo Excel nachfrägt ob externe Dateiinhalte aktualisiert werden sollen.
Bei der Suche brauche ich keine Aktualisierung weshalb ich diese mit Abbrechen beende; allerdings unterbricht die Abfrage den Ablauf des Makros.
Da die Suche einige Zeit dauert, wäre es gut wenn ich nicht davorsitzen müsste um zB solche Abfragen wie externe Inhalte aktualisieren zu beantworten.

Alternativ käme auch in Betracht diesen Wunsch externe Inhalte zu aktualisieren ganz zu unterbinden. Ich weiß von keiner Datei, dass diese auf externe Inhalte zu greift.
Möglicherweise ist bei diesen Dateien etwas beim Kopieren und Einfügen durcheinander geraten oder als diese Datei kopiert oder mit neuem Namen gespeichert wurde.
Ich habe auch keine Idee auf welche externen Inhalte die Datei zurückgreifen möchte.

Hat jemand eine Idee wie ich das gelöst bekomme?
Herzlichen Dank und viele Grüße
MiSchi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Danke Rudi,

und jetzt bin ich an meinen VBA-Grenzen. Den Code habe ich aus einem Forum.
Weshalb ich nicht weiß, was ich alles anpassen muß.

Anbei der Code; ggf kannst Du mir bei der Anpassung helfen?

'https://www.ms-office-forum.net/forum/showthread.php?t=369481
'#3
'Nachfolgender Code durchsucht nur Exceldateien in einem Pfad (Ordner)
'Karl-Heinz alias Volti

'Info: Zum Durchsuchen von xlsm-Dateien vorher Trust Center Einstellung anzupassen

'Option Explicit

Sub Suche_in_allen_Dateien_xls()
 Dim sSuch As String, iOutZeile As Long, xSuch As Integer, iAnz As Integer
 Dim sSuchArr() As String
 Dim WkB As Workbook, WSh As Worksheet
 Dim oRange As Range
 Dim sFirstAddress As String
 Dim sPathname As String, sFilename As String, sEinschl As String
 Dim iClick As Integer
 
     Application.DisplayAlerts = False

    iClick = MsgBox( _
       prompt:="Zum Durchsuchen von xlsm-Dateien vorher unter Optionen: Trust Center Einstellung anzupassen" & vbCrLf & _
       "OK: sind eingestellt -> weiter" & vbCrLf & _
       "oder" & vbCrLf & _
       "Abbrechen -> müssen noch geändert werden", _
       Buttons:=vbOKCancel)
    If Not iClick = vbOK Then  '-------------------------------------------------------------------(4)
       Exit Sub
    Else
    'End If  '-------------------------------------------------------------------------------------(4 auch hier mgl?)
 
         'sPathname = "C:\MSch\Excel\" '>>
         sPathname = ThisWorkbook.Sheets("Suche").Cells(2, 2).Value
         
         'sSuch = InputBox("Suchbegriff(e) kommagetrennt eingeben (ggf. mit *)")
         sSuch = ThisWorkbook.Sheets("Suche").Cells(3, 2).Value
         sEinschl = ThisWorkbook.Sheets("Suche").Cells(4, 2).Value
         If StrPtr(sSuch) = 0 Then Exit Sub
         If sSuch = "" Then Exit Sub
         sSuchArr = Split(sSuch, ",")
         
         With Application
            .ScreenUpdating = True
            .EnableEvents = False
            .Calculation = xlCalculationManual
         End With
         
         iOutZeile = 2
         With ThisWorkbook.Sheets("Tabelle1")
            .Cells.ClearContents
            .Range("$A$1").Resize(1, 4).Value = Split("Mappe,Tabelle,Zelle,Suchbegriff", ",")
            .Cells(2, "A").Value = "Suchbegriff '" & sSuch & "' wurde nicht gefunden!"
          End With
        
        
        'Alle Dateien entsprechend der Dir-Maske im Pfad durchgehen
         sFilename = Dir(sPathname & "*.xls*")     'Nur Excel-Dateien ggf. anpassen
         

         Do While sFilename > ""  '----------------------------------------------------------------(Loop)
              
            'nur Dateien durchsuchen, die sEinschl im Dateinamen enthalten
            If InStr(1, sFilename, sEinschl, 1) > 0 Then           '1: vbTextCompare  --------(3)      "optionaler" Startwert muß angegeben werden sonst Typenunverträglich!?
              
                  Set WkB = GetObject(PathName:=sPathname & sFilename)  '-------------------------     "öffnen" der Datei =>
                  If Not WkB Is Nothing Then  '---------------------------------------(2)
                
                   Application.StatusBar = WkB.Name & " wird gerade durchsucht"
                   For Each WSh In WkB.Worksheets
                
                       With WSh
                         For xSuch = 0 To UBound(sSuchArr)
                          
                          Set oRange = .Cells.Find(What:=sSuchArr(xSuch), _
                              After:=.Cells(.Rows.Count, .Columns.Count), _
                              LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
                
                          If Not oRange Is Nothing Then  '-----------------------(1)
                
                              sFirstAddress = oRange.Address
                
                              Do
                'Suche erfolgreich
                                With ThisWorkbook.Sheets("Tabelle1")
                                 .Cells(iOutZeile, "A").Value = WkB.Name
                                 .Cells(iOutZeile, "B").Value = WSh.Name
                                 .Cells(iOutZeile, "C").Value = oRange.Address
                                 .Cells(iOutZeile, "D").Value = oRange.Value
                                End With
                                iOutZeile = iOutZeile + 1
                                iAnz = iAnz + 1
                                DoEvents
                                Set oRange = .Cells.FindNext(oRange)
                              Loop Until oRange.Address = sFirstAddress
                
                              Set oRange = Nothing
                            
                          End If  '----------------------------------------------(1)
                        
                         Next xSuch
                       End With
                   Next WSh
                  
                  WkB.Close Savechanges:=False     'Schließen, ohne zu speichern
                  Set WkB = Nothing
                  
                  End If  '------------------------------------------------------------(2)
         
            End If  '-----------------------------------------------------------------------(3)
         
          sFilename = Dir
         Loop  '----------------------------------------------------------------------------------------(Loop)

    End If  '--------------------------------------------------------------------------------------(4)

    With Application
       .ScreenUpdating = True
       .EnableEvents = True
       .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox "Es wurden " & iAnz & " Treffer gefunden!", vbInformation, "Suchbegriff suchen"
    
    MsgBox "Trust Center Einstellung wieder zurücksetzen!", vbInformation
 
End Sub

Viele Grüße
Michael

Sub Suche_in_allen_Dateien_xls() Dim sSuch As String, iOutZeile As Long, xSuch As Integer, iAnz As Integer Dim sSuchArr() As String Dim WkB As Workbook, WSh As Worksheet Dim oRange As Range Dim sFirstAddress As String Dim sPathname As String, sFilename As String, sEinschl As String If MsgBox( _ prompt:="Zum Durchsuchen von xlsm-Dateien vorher unter Optionen: Trust Center Einstellung anzupassen" & vbCrLf & _ "OK: sind eingestellt -> weiter" & vbCrLf & _ "oder" & vbCrLf & _ "Abbrechen -> müssen noch geändert werden", _ Buttons:=vbOKCancel) > vbOK Then '-------------------------------------------------------------------(4) Exit Sub End If '-------------------------------------------------------------------------------------(4 auch hier mgl?) ' sPathname = "C:\MSch\Excel\" '>> sPathname = ThisWorkbook.Sheets("Suche").Cells(2, 2).Value ' sSuch = InputBox("Suchbegriff(e) kommagetrennt eingeben (ggf. mit *)") sSuch = ThisWorkbook.Sheets("Suche").Cells(3, 2).Value sEinschl = ThisWorkbook.Sheets("Suche").Cells(4, 2).Value 'If StrPtr(sSuch) = 0 Then Exit Sub ' nur bei Inputbox erforderlich, kann weg If sSuch = "" Then Exit Sub sSuchArr = Split(sSuch, ",") With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With iOutZeile = 2 With ThisWorkbook.Sheets("Tabelle1") .Cells.ClearContents .Range("$A$1").Resize(1, 4).Value = Split("Mappe,Tabelle,Zelle,Suchbegriff", ",") .Cells(2, "A").Value = "Suchbegriff '" & sSuch & "' wurde nicht gefunden!" End With ' Alle Dateien entsprechend der Dir-Maske im Pfad durchgehen sFilename = Dir(sPathname & "*.xls*") 'Nur Excel-Dateien ggf. anpassen Do While sFilename > "" '----------------------------------------------------------------(Loop) ' nur Dateien durchsuchen, die sEinschl im Dateinamen enthalten If InStr(1, sFilename, sEinschl, 1) > 0 Then '1: vbTextCompare --------(3) "optionaler" Startwert muß angegeben werden sonst Typenunverträglich!? 'Set WkB = GetObject(PathName:=sPathname & sFilename) '------------------------- "öffnen" der Datei => Application.DisplayAlerts = False Set WkB = Workbooks.Open(Filename:=sPathname & sFilename, UpdateLinks:=False) Application.DisplayAlerts = True If Not WkB Is Nothing Then '---------------------------------------(2) Application.StatusBar = WkB.Name & " wird gerade durchsucht" For Each WSh In WkB.Worksheets With WSh For xSuch = 0 To UBound(sSuchArr) Set oRange = .Cells.Find(What:=sSuchArr(xSuch), _ After:=.Cells(.Rows.Count, .Columns.Count), _ LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False) If Not oRange Is Nothing Then '-----------------------(1) sFirstAddress = oRange.Address Do ' Suche erfolgreich With ThisWorkbook.Sheets("Tabelle1") .Cells(iOutZeile, "A").Value = WkB.Name .Cells(iOutZeile, "B").Value = WSh.Name .Cells(iOutZeile, "C").Value = oRange.Address .Cells(iOutZeile, "D").Value = oRange.Value End With iOutZeile = iOutZeile + 1 iAnz = iAnz + 1 DoEvents Set oRange = .Cells.FindNext(oRange) Loop Until oRange.Address = sFirstAddress Set oRange = Nothing End If '----------------------------------------------(1) Next xSuch End With Next WSh WkB.Close Savechanges:=False 'Schließen, ohne zu speichern Set WkB = Nothing End If '------------------------------------------------------------(2) End If '-----------------------------------------------------------------------(3) sFilename = Dir Loop '----------------------------------------------------------------------------------------(Loop) With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "Es wurden " & iAnz & " Treffer gefunden!", vbInformation, "Suchbegriff suchen" MsgBox "Trust Center Einstellung wieder zurücksetzen!", vbInformation End Sub

Do ' Suche erfolgreich With ThisWorkbook.Sheets("Tabelle1") .Cells(iOutZeile, "A").Value = WkB.Name .Cells(iOutZeile, "B").Value = WSh.Name .Cells(iOutZeile, "C").Value = oRange.Address .Cells(iOutZeile, "D").Value = oRange.Value End With iOutZeile = iOutZeile + 1 iAnz = iAnz + 1 DoEvents Set oRange = .Cells.FindNext(oRange) Loop Until oRange.Address = sFirstAddress

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Abfrage überspringen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread