mit Excel IE öffnen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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 Long) As 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 Long, ByVal lpszConiID As String, ByVal dwFlags As Long, ByRef hCon As Long, ByVal dwReserved As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const DIAL_FORCE_ONLINE = 1
Private Const DIAL_FORCE_UNATTENDED = 2
Public Function RASConnect(ByVal hWnd As Long, Optional ByVal DFÜName As String, Optional ByVal AutoStart As Boolean) As 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/" title="Auf der Suche nach einer Lösung für deine Excel-Probleme? Dann bist du beim Excel-Forum xlforum.herber.de genau richtig! Unser Forum bietet dir eine breite Palette an Expertenwissen, Tipps und Tricks rund um das Thema Excel. Egal, ob du ein Anfänger bist oder bereits Erfahrung hast, unsere Community steht dir jederzeit mit Rat und Tat zur Seite. Du möchtest mehr über die neuesten Excel-Features erfahren? Oder brauchst du Hilfe bei der Erstellung komplexer Formeln? Kein Problem! In unserem Forum findest du eine Vielzahl von Beiträgen, die dir dabei helfen, deine Excel-Kenntnisse zu verbessern. Und das Beste: Das Excel-Forum xlforum.herber.de ist komplett kostenlos! Melde dich noch heute an und werde Teil unserer wachsenden Community von Excel-Enthusiasten. Wir freuen uns darauf, dich kennenzulernen und dir dabei zu helfen, das Beste aus Excel herauszuholen!">
    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 Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As 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 Long) As 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 Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As 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 String, ByVal lpWindowName As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As 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 Long) As 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

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mit Excel IE öffnen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread