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