Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1120to1124
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

FileSystemObject und http-Links?

FileSystemObject und http-Links?
frigo
Hallo zusammen,
ich habe ein Makro, das alle Hyperlinks in einem Excel-Worksheet auf Existenz der Datei überprüft.
Mit allen Links auf Dateien auf einem NT-Share funktioniert dies auch prima, allerdings nicht mit Dateien, die z.B. im Firmen-Intranet eingestellt sind (z.B. 'http://www.intranet.meinefirma.de/bla/Datei.pdf').
Das FSO bingt immer zurück, die Datei würde nicht existieren, obwohl der manuelle Aufruf bestens funktioniert.
Set myFSO = CreateObject("Scripting.FileSystemObject")
IF NOT myFSO.fileexists(myLink.Adress) then ...
Welche Möglichkeit gibt es um auch auf Dateien im Netz zuzugreifen?
DIR(myLink.Adress) bringt sogar einen Laufzeitfehler (funktioniert aber auch prima mit NT-Shares).
Dankeschön im Voraus!
frigo

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: FileSystemObject und http-Links?
25.11.2009 17:56:25
Josef
Hallo Frigo,
probier's aml so. Der Code prüft jetzt die Zellen A1:A20 und schreibt in B1:B20 das Ergebnis.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" ( _
  ByVal lpszUrl As String, _
  ByVal dwFlags As Long, _
  ByVal dwReserved As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, _
  ByRef lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
  ByVal hFindFile As Long) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH As Long = 260
Private Const FLAG_ICC_FORCE_CONNECTION As Long = &H1

Function URLExist(chkUrl As String) As Boolean
  URLExist = InternetCheckConnection(chkUrl, FLAG_ICC_FORCE_CONNECTION, 0&) <> 0
End Function

Function FileExists(ByRef strFileName As String) As Boolean
  Dim wfdWFD As WIN32_FIND_DATA
  Dim hFile As Long
  hFile = FindFirstFile(strFileName, wfdWFD)
  FileExists = (hFile <> INVALID_HANDLE_VALUE)
  Call FindClose(hFile)
End Function

Sub testLink()
  Dim rng As Range
  Dim strLink As String
  
  For Each rng In Range("A1:A20")
    strLink = rng.Text
    If strLink Like "http://*" Then
      rng.Offset(0, 1) = IIf(URLExist(strLink), "existiert", "existiert nicht")
    Else
      rng.Offset(0, 1) = IIf(FileExists(strLink), "existiert", "existiert nicht")
    End If
  Next
  
End Sub

Gruß Sepp

Anzeige
fast...
25.11.2009 18:26:16
frigo
Hallo Sepp,
Vielen Dank erstmal! Damit bin ich einen großen Schritt weiter!
Leider bringt diese Prüfung bei Http-Links nun immer Wahr zurück.
Ich vermute es liegt daran, dass der Server bei ungültigen Links eine allgemeingültige Fehlerseite zurückbringt (z.B. "Die von Ihnen gewünschte Seite ist leider nicht verfügbar...".
Damit gibt die Funktion InternetCheckConnection wahr zurück.
Hast Du hier nochmal so eine göttliche Eingebung?
Danke!
frigo
AW: fast...
25.11.2009 20:53:58
Josef
Hallo Frigo,
dann versuch mal das.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, _
  ByRef lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
  ByVal hFindFile As Long) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH As Long = 260

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Private Function checkURL(url As String) As Boolean
  Dim request As Object
  
  Set request = CreateObject("WinHttp.WinHttpRequest.5.1")
  
  On Error Resume Next
  request.Open "GET", url
  request.Send
  checkURL = request.Status = 200
  On Error GoTo 0
End Function
Function FileExists(ByRef strFileName As String) As Boolean
  Dim wfdWFD As WIN32_FIND_DATA
  Dim hFile As Long
  hFile = FindFirstFile(strFileName, wfdWFD)
  FileExists = (hFile <> INVALID_HANDLE_VALUE)
  Call FindClose(hFile)
End Function

Sub testLink()
  Dim rng As Range
  Dim strLink As String
  
  For Each rng In Range("A1:A20")
    strLink = rng.Text
    If strLink Like "http://*" Then
      rng.Offset(0, 1) = IIf(checkURL(strLink), "existiert", "existiert nicht")
    Else
      rng.Offset(0, 1) = IIf(FileExists(strLink), "existiert", "existiert nicht")
    End If
  Next
  
End Sub

Gruß Sepp

Anzeige
Super! (dennoch Nachfrage erforderlich)
26.11.2009 12:18:29
frigo
Hallo Sepp,
super vielen Dank. Funktioniert. (Beim allerersten Test hat es zwar auch bei einer existierenden Datei FALSCH gemeldet, aber ohne Veränderung der Daten hat es danach immer geklappt. Vielleicht ein temporäres Netzwerkproblem...)
Kannst Du mir eine Site oder ein Buch empfehlen, wo man sich in die Nutzung von DLLs einlesen kann bzw. wie man rausfindet, welche DLL welche Möglichkeiten bieten?
Danke,
frigo

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige