mit Excel IE öffnen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Frame MsgBox
Bild

Betrifft: mit Excel IE öffnen
von: Edgar
Geschrieben am: 14.02.2005 21:21:36
Hallo Profis.
Ich würde gerne aus Excel heraus, per Makro, mein Modem aufrufen und nur noch durch ein ok bestätigen, dass die Internetverbindung hergestellt wird. Dann soll eine bestimmte Webseite automatisch aufgerufen werden.
Genauso komfortabel möchte ich mit einem Makro die Modemverbindung trennen können. Im Anschluss soll im IE der „Verlauf“ geleert werden und die Cookies gelöscht. Zum Schluß sollte das Makro den IE schließen.
Ist das möglich?
Wenn ja, wie?
Danke Edgar

Bild

Betrifft: hat hier wirklich keiner eine Idee????????
von: edgar
Geschrieben am: 14.02.2005 23:27:38
hat hier wirklich keiner eine Idee????????
Bild

Betrifft: AW: hat hier wirklich keiner eine Idee????????
von: Kurt
Geschrieben am: 14.02.2005 23:37:17
Das ist keine Frage sondern ein Programmierauftrag.
Kurt
Bild

Betrifft: AW: mit Excel IE öffnen
von: Nepumuk
Geschrieben am: 15.02.2005 11:02:26
Hallo Edgar,
ich liefere dir mal die Einzelteile. Ein IKEA-Makro zum zusammenbastelen (wohnst du schon oder schraubst du noch?)
1. Prüfen ob eine Verbindung besteht:


Option Explicit
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As LongAs Long
Private Enum Constant
    RAS_MaxEntryName = 256
    RAS_MaxDeviceType = 16
    RAS_MaxDeviceName = 32
    Max_Fill = 96
End Enum
Private Type RASType
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
    dwFill(Max_Fill) As Byte
End Type
Public Sub Verbindungstest()
    Dim RAS(255) As RASType
    Dim lg As Long, lpcon As Long
    RAS(0).dwSize = 412
    lg = 256 * RAS(0).dwSize
    RasEnumConnections RAS(0), lg, lpcon
    If lpcon = 0 Then
        MsgBox "Keine Online-Verbindung gefunden", 64, "Information"
    Else
        MsgBox "Online-Verbindung steht", 64, "Information"
    End If
End Sub


2. Verbindung herstellen:


Option Explicit
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As LongByVal lpszConiID As StringByVal dwFlags As LongByRef hCon As LongByVal dwReserved As LongAs Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As StringByVal lpWindowName As StringAs Long
Private Const DIAL_FORCE_ONLINE = 1
Private Const DIAL_FORCE_UNATTENDED = 2
Public Function RASConnect(ByVal hWnd As LongOptional ByVal DFÜName As StringOptional ByVal AutoStart As BooleanAs Boolean
    Dim conID As Long
    InternetDial hWnd, DFÜName, IIf(AutoStart, DIAL_FORCE_UNATTENDED, DIAL_FORCE_ONLINE), conID, 0
    RASConnect = (conID <> 0)
End Function
Public Sub Verbindungsaufbau()
    Dim bolRet As Boolean
    bolRet = RASConnect(FindWindow("XLMAIN", vbNullString), "", False'ohne Name der Verbindung ohne automatik
'    bolRet = RASConnect(FindWindow("XLMAIN", vbNullString), "", False) 'ohne Name der Verbindung mit automatik
'    bolRet = RASConnect(FindWindow("XLMAIN", vbNullString), "t-online", True) 'mit Namen mit automatik
'    bolRet = RASConnect(FindWindow("XLMAIN", vbNullString), "t-online", True) 'mit Namen ohne automatik
    MsgBox "Internetverbindung" & IIf(bolRet, " wurde hergestellt", "saufbau wurde abgebrochen"), 64, "Information"
End Sub


3. Internetsite aufrufen:


Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub URL_Load()
    Dim myIE_App As Object, strText As String
    Set myIE_App = CreateObject("InternetExplorer.Application")
    myIE_App.Navigate "https://www.herber.de/forum/"
    Do
        Sleep 10
    Loop Until myIE_App.Busy = False
End Sub


4. Internetexplorer schließen:


Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As LongByVal wCmd As LongAs Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongByVal wIndx As LongAs Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongAs Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongByVal lpString As StringByVal cch As LongAs Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As StringByVal lpWindowName As StringAs Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongByVal wMsg As LongByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongByVal lpClassName As StringByVal nMaxCount As LongAs Long
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GWL_STYLE = -16
Private Const WS_VISIBLE = &H10000000
Private Const WS_BORDER = &H800000
Private Const WM_CLOSE = &H10
Private Const gcClassnameMSIExplorer = "IEFrame"
Public Sub IE_close()
    Dim lng_hwnd As Long, lng_style As Long
    Dim lpClassName As String, RetVal As Long
    lpClassName = Space(256)
    lng_hwnd = GetWindow(FindWindow(vbNullString, vbNullString), GW_HWNDFIRST)
    Do
        lng_style = GetWindowLong(lng_hwnd, GWL_STYLE) And (WS_VISIBLE Or WS_BORDER)
        If (lng_style = (WS_VISIBLE Or WS_BORDER)) = True And Trim$(GetWindowTitle(lng_hwnd)) <> "" Then
            RetVal = GetClassName(lng_hwnd, lpClassName, 256)
            If gcClassnameMSIExplorer = Left$(lpClassName, RetVal) Then PostMessage lng_hwnd, WM_CLOSE, 0&, 0&
        End If
        lng_hwnd = GetWindow(lng_hwnd, GW_HWNDNEXT)
    Loop Until lng_hwnd = 0
End Sub
Private Function GetWindowTitle(ByVal lng_hwnd As LongAs String
    Dim lng_result As Long, str_temp As String
    lng_result = GetWindowTextLength(lng_hwnd) + 1
    str_temp = Space(lng_result)
    lng_result = GetWindowText(lng_hwnd, str_temp, lng_result)
    GetWindowTitle = Left(str_temp, Len(str_temp) - 1)
End Function


5. Verbindung trennen:


Option Explicit
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As LongAs Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As LongAs Long
Private Enum Constant
    RAS_MaxEntryName = 256
    RAS_MaxDeviceType = 16
    RAS_MaxDeviceName = 32
    Max_Fill = 96
End Enum
Private Type RASType
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
    dwFill(Max_Fill) As Byte
End Type
Public Sub Trennen()
    Dim RAS(255) As RASType
    Dim lg As Long, lpcon As Long
    RAS(0).dwSize = 412
    lg = 256 * RAS(0).dwSize
    RasEnumConnections RAS(0), lg, lpcon
    If lpcon = 0 Then
        MsgBox ("Keine Online-Verbindung gefunden")
    Else
        RasHangUp ByVal RAS(0).hRasCon
    End If
End Sub


6. Ordner leeren:


Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As StringByVal lpWindowName As StringAs Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As LongByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongByVal pszPath As StringAs Long
Private Type ITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As ITEMID
End Type
Private Const CSIDL_HISTORY As Long = &H22
Private Const CSIDL_COOKIES As Long = &H21
Private Const NOERROR As Long = 0&
Public Sub Clear_Cookies_and_History()
    Dim myFSO As Object, myFile As Object, myFolder1 As Object, myFolder2 As Object
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo Err_Exit
    For Each myFolder1 In myFSO.getfolder(GetPath(CSIDL_HISTORY)).SubFolders
        For Each myFolder2 In myFolder1.SubFolders
            myFolder2.Delete
        Next
    Next
    On Error Resume Next
    For Each myFile In myFSO.getfolder(GetPath(CSIDL_COOKIES)).Files
        myFile.Delete
    Next
    Set myFSO = Nothing
    Exit Sub
Err_Exit:
    Select Case Err.Number
        Case 70
            MsgBox "Der heutige Verlauf kann nicht gelöscht werden," & vbLf & "da der Internetexplorer noch geöffnet ist.", 16, "Warnung"
            Resume Next
        Case Else
            MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & Err.Description, 16, "Fehler"
    End Select
End Sub
Private Function GetPath(Num As LongAs String
    Dim Result As Long
    Dim Buff As String
    Dim idl As ITEMIDLIST
    Result = SHGetSpecialFolderLocation(FindWindow("XLMAIN", vbNullString), Num, idl)
    If Result = NOERROR Then
        Buff = Space$(512)
        Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
        If Result Then GetPath = Trim$(Buff)
    End If
End Function


Gruß
Nepumuk
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zellwert bei Dubletten-Vorkommen auf Null stellen"