Microsoft Excel

Herbers Excel/VBA-Archiv

FileSystemObject und http-Links? | Herbers Excel-Forum


Betrifft: FileSystemObject und http-Links? von: frigo
Geschrieben am: 25.11.2009 17:25:37

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

  

Betrifft: AW: FileSystemObject und http-Links? von: Josef Ehrensberger
Geschrieben am: 25.11.2009 17:56:25

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



  

Betrifft: fast... von: frigo
Geschrieben am: 25.11.2009 18:26:16

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


  

Betrifft: AW: fast... von: Josef Ehrensberger
Geschrieben am: 25.11.2009 20:53:58

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



  

Betrifft: Super! (dennoch Nachfrage erforderlich) von: frigo
Geschrieben am: 26.11.2009 12:18:29

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


  

Betrifft: AW: Super! (dennoch Nachfrage erforderlich) von: Josef Ehrensberger
Geschrieben am: 26.11.2009 17:04:20

Hallo Frigo,

da gibt's unzählige Quellen, Googel und

http://www.activevb.de/cgi-bin/suche/search.pl

und

http://allapi.mentalis.org/apilist/apilist.php

und .....

Gruß Sepp