26.04.2013

API - Ordner anlegen - Dateien aus dem Internet laden...

Frage: Mehrere Dateien sollen aus dem Internet in einen bestimmten Ordner geladen werden (PNG, ZIP, PDF, XLS). Der Ordner soll ohne Nachfrage angelegt werden, wenn er nicht vorhanden ist. Die Dateien sollen lokal den gleichen Namen tragen den sie auch im Internet haben. Wie geht das?

Multiple files should be loaded from the Internet to a specific folder (PNG, ZIP, PDF, XLS). The folder should be created without asking if it is not present. The files are locally the same names they have in the internet. How does it work?

Hier noch eine Beispieldatei / Here's a sample file:
API - Ordner anlegen - Dateien aus dem Internet laden...[XLS 50 KB]

'--------------------------------------------------------------------------
' Module    : Module1
' Author    : Case (Ralf Stolzenburg)
' Date      : 26.04.2013
' Purpose   : Ordner erstellen - Dateien aus dem Internet laden...
'--------------------------------------------------------------------------
Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
' Pfad evtl. anpassen - abschliessenden Backslash NICHT vergessen!!!
' Ordner wird automatisch angelegt, wenn er nicht vorhanden ist
Const strBackup As String = "C:\Temp\"
Public Sub GetFiles()
    On Error GoTo Fin
    LoadFiles "http://www.comburg.de/blog/files/Download.pdf"
    LoadFiles "http://www.comburg.de/blog/files/XCOPY_and_more.zip"
    LoadFiles "http://www.comburg.de/blog/files/WMI.xls"
    LoadFiles "http://www.comburg.de/blog/files/Local_Window.png"
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Public Sub LoadFiles(ByVal strURL As String)
    Dim lngTMP As Long
    Call DeleteUrlCacheEntry(strURL)
    MakeSureDirectoryPathExists strBackup
    lngTMP = URLDownloadToFile(0, strURL, strBackup & _
        Mid(strURL, InStrRev(strURL, "/") + 1), 0, 0)
End Sub

24.04.2013

OnScreenKeyboard - OSK - Bildschirmtastatur...

Frage: Besteht die Möglichkeit über eine Bildschirmtastatur in einer TextBox (diese ist in einer UserForm) Text und Zahlen einzugeben? Die Tastatur soll immer sichtbar sein, wenn die TextBox aktiv ist, sonst nicht.

Is possible via an onscreen keyboard in a TextBox (this is in a user form) enter text and numbers? The keyboard should always be visible when the TextBox is active, otherwise not.

Hier noch eine Beispieldatei / Here's a sample file:
OnScreenKeyboard - OSK - Bildschirmtastatur...[XLS 40 KB]

'--------------------------------------------------------------------------
' Module    : UserForm1
' Author    : Case (Ralf Stolzenburg)
' Date      : 25.04.2013
' Purpose   : On Screen Keyboard - OSK - Bildschirmtastatur...
'--------------------------------------------------------------------------
Option Explicit
Private Sub CommandButton1_Click()
    Shell "wmic Process where ""name='osk.exe'"" call terminate", vbHide
    Unload Me
End Sub
Private Sub TextBox1_Enter()
    TextBox1.Text = ""
    ShellAndWait "cmd /c osk"
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Shell "wmic Process where ""name='osk.exe'"" call terminate", vbHide
End Sub
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : ShellAndWait
' Author    : Case (Ralf Stolzenburg)
' Date      : 25.04.2013
' Purpose   : ShellAndWait mit ausgeblendetem Dosfenster...
'--------------------------------------------------------------------------
Private Sub ShellAndWait(ByVal strPathName As String)
   Dim WshShell As Object
   On Error GoTo Fin
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.Run strPathName, 0, True
Fin:
   Set WshShell = Nothing
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub
' UserForm nicht über das "X" schliessen lassen
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True
End Sub

XCOPY - SHELL und ein paar Dinge mehr...

Frage: Alle Exceldateien eines Ordners als Sicherungskopie in einen anderen Ordner kopieren. Wie geht das?

Programme direkt im VBA Editor starten. Informationen bzw. Parameter zu bestimmten Dos Befehlen in einer Textdatei mit Notepad anzeigen.

Damit das "gute alte Dos" nicht in Vergessenheit gerät. :-)

All Excel files in a folder as a backup copy in another folder. How does it work?

Launch programs directly in the VBA editor. Information or parameters on certain dos commands display in a text file with Notepad.

Thus, the "good old Dos" will not be forgotten. :-)

Hier noch eine Beispieldatei / Here's a sample file:
XCOPY - SHELL und ein paar Dinge mehr...[ZIP 50 KB]

'--------------------------------------------------------------------------
' Module    : Module1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : XCOY, SHELL - Beispiele und Informationen ausgeben...
'--------------------------------------------------------------------------
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Const strTMP As String = "C:\Temp\"
Const strEX As String = "*.xls"
' Alle Exceldateien die im Unterordner "source" sind (dieser befindet sich
' unterhalb des Pfades in dem die Datei mit diesem Code ist) werden in das
' Unterverzeichnis "destination" kopiert. Wird der Code zum zweiten mal
' ausgeführt, WIRD nachgefragt, ob die vorhandenen Dateien
' überschrieben werden sollen.
Sub Main()
    Shell ("xcopy " & ThisWorkbook.Path & Application.PathSeparator & "source" & _
        Application.PathSeparator & strEX & " " & ThisWorkbook.Path & _
        Application.PathSeparator & "destination")
End Sub
' Alle Exceldateien die im Unterordner "source" sind (dieser befindet sich
' unterhalb des Pfades in dem die Datei mit diesem Code ist) werden in das
' Unterverzeichnis "destination" kopiert. Wird der Code zum zweiten mal
' ausgeführt, wird NICHT nachgefragt, ob die vorhandenen Dateien
' überschrieben werden sollen.
Sub Main_1()
    Shell ("xcopy /Y " & ThisWorkbook.Path & Application.PathSeparator & "source" & _
        Application.PathSeparator & strEX & " " & ThisWorkbook.Path & _
        Application.PathSeparator & "destination")
End Sub
' Bindet den Pfad "C:\Temp\source" als Laufwerk w: ein
Sub Main_2()
    Shell ("subst w: " & ThisWorkbook.Path & Application.PathSeparator & "source")
    Shell "Explorer.exe /E, w:", vbMaximizedFocus
End Sub
' Entfernt das virtuelle Laufwerk w:
Sub Main_3()
    Shell ("subst /d w:")
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterX
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von XCOPY in Notepad ausgeben...
'--------------------------------------------------------------------------
Sub ParameterX()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c xcopy /? > " & strTMP & "xco.txt"
    Shell "Notepad " & strTMP & "xco.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterS
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Parameter von SET an bestehende Datei anhängen...
'--------------------------------------------------------------------------
Sub ParameterS()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c set /? >> " & strTMP & "xco.txt"
    Shell "Notepad " & strTMP & "xco.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterI
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterI()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c ipconfig /all > " & strTMP & "ip.txt"
    Shell "Notepad " & strTMP & "ip.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterT()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c tasklist > " & strTMP & "ta.txt"
    Shell "Notepad " & strTMP & "ta.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ParameterT1
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : Komplette IP Konfiguration aller LAN Adapter ausgeben...
'--------------------------------------------------------------------------
Sub ParameterT1()
    On Error GoTo Fin
    MakeSureDirectoryPathExists strTMP
    ShellAndWait "cmd /c tasklist /V > " & strTMP & "ta1.txt"
    Shell "Notepad " & strTMP & "ta1.txt", vbMaximizedFocus
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ShellAndWait
' Author    : Case (Ralf Stolzenburg)
' Date      : 24.04.2013
' Purpose   : ShellAndWait mit ausgeblendetem Dosfenster...
'--------------------------------------------------------------------------
Private Sub ShellAndWait(ByVal strPathName As String)
   Dim WshShell As Object
   On Error GoTo Fin
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.Run strPathName, 0, True
Fin:
   Set WshShell = Nothing
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub

17.04.2013

WMIC - Informationen per Shell - und mehr...

Frage: Letzte Nachfrage - Internetexplorer Fenster schließen. Wenn alle Internetexplorer Fenster (nicht wie gestern bestimmte) geschlossen werden sollen - geht das dann einfacher? Ja - wenn WMI (Windows Management Instrumentation) geht (Firmennetz, Rechte) funktioniert das mit nur einer Zeile Code.

Zusätzlich noch einige Codes mit Infos über das Betriebssystem oder das Bios.

Und es wird gezeigt wie auf "Shell" bis zum beenden gewartet wird.

Die Informationen werden im VBA-Editor Direktfenster ausgegeben (STRG+G bzw. CTRL+G).

Final demand - close Internet Explorer windows. If all Internet Explorer windows (not certain as yesterday) will be closed - that's easier then? Yes - if WMI (Windows Management Instrumentation) is working (Corporate network, Rights), it works with only one line of code.

Additionally, some codes with information about the operating system or the BIOS.

And it is shown how to "shell" will wait until the end.

The information is displayed in the VBA Editor Immediate Window (Ctrl+G or CTRL+G).

Hier noch eine Beispieldatei / Here's a sample file:
WMIC - Informationen per Shell - und mehr...[XLS 50 KB]

Hier noch ein paar Links zum Thema / Here are a few links:
Wenn die Links nicht mehr erreichbar sind, einfach nach "wmic" in einer Suchmaschine suchen.
If the links are no longer available, simply search for "wmic" in a search engine.

WMI 1...
WMI 2...
WMI 3...
WMI 4...

'--------------------------------------------------------------------------
' Module    : Module1
' Author    : Case (Ralf Stolzenburg)
' Date      : 17.04.2013
' Purpose   : WMIC - Beispiele Shell diverse Informationen ausgeben...
'--------------------------------------------------------------------------
Option Explicit
' Alle Internetexplorerfenster schliessen nach Name
Sub Main()
    Shell "wmic Process where ""name='iexplore.exe'"" call terminate", vbHide
End Sub
' Alle Internetexplorerfenster schliessen mit LIKE
Sub Main_1()
    Shell "wmic Process where ""name like '%iexplo%'"" call terminate", vbHide
End Sub
' Informationen über die angeschlossenen Laufwerke
Sub Main_2()
    ShellAndWait "wmic /output:clipboard logicaldisk get name,volumename,filesystem"
    Debug.Print fncCPRead()
End Sub
' Informationen über das Bios
Sub Main_3()
    ShellAndWait "wmic /output:clipboard bios list full"
    Debug.Print fncCPRead()
End Sub
' Bestimmte Informationen vom Bios (Hersteller und Seriennummer)
Sub Main_4()
    ShellAndWait "wmic /output:clipboard bios get manufacturer,serialnumber"
    Debug.Print fncCPRead()
End Sub
' Informationen über die angelegten Benutzerkonten
Sub Main_5()
    ShellAndWait "wmic /output:clipboard useraccount get /value"
    Debug.Print fncCPRead()
End Sub
' Informationen über laufende Anwendungen die NICHT im Windowspfad sind
Sub Main_6()
    ShellAndWait "wmic /output:clipboard PROCESS WHERE " & _
        """NOT ExecutablePath LIKE '%Windows%'"" GET ExecutablePath"
    Debug.Print fncCPRead()
End Sub
' Informationen über die Startvorgänge
Sub Main_7()
    ShellAndWait "wmic /output:clipboard startup list full"
    Debug.Print fncCPRead()
End Sub
' Informationen über das Betriebssystem formatiert ausgeben
Sub Main_8()
    ShellAndWait "wmic /output:clipboard os get /value /format:htable"
    Call fncCPRead
    With Sheet1
        .Cells(1, 1).PasteSpecial
        .Cells.WrapText = False
        .Columns.EntireColumn.AutoFit
    End With
End Sub
' Informationen über die Prozesse formatiert ausgeben
Sub Main_9()
    ShellAndWait "wmic /output:clipboard process get /value /format:htable"
    Call fncCPRead
    With Sheet1
        .Cells(1, 1).PasteSpecial
        .Cells.WrapText = False
        .Columns.EntireColumn.AutoFit
    End With
End Sub
Public Sub Main_IE()
    ' NUR zum testen. Der IE wird viermal aufgerufen
    ' Dreimal mit meiner Blogseite und einmal mit einem Excelforum
    On Error GoTo Fin
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://www.herber.de/forum/")
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : IE_Run
' Author    : Case (Ralf Stolzenburg)
' Date      : 17.04.2013
' Purpose   : Internetexplorer mit bestimmten Seiten starten...
'--------------------------------------------------------------------------
Private Sub IE_Run(ByVal strAddress As String)
    Dim objIEApp As Object
    Set objIEApp = CreateObject("InternetExplorer.Application")
    With objIEApp
        .Navigate strAddress
        Do: Loop Until .Busy = False
        Do: Loop Until .Busy = False
        .Visible = True
    End With
    Set objIEApp = Nothing
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : fncCPRead
' Author    : Case (Ralf Stolzenburg)
' Date      : 17.04.2013
' Purpose   : Zwischenablage auslesen...
'--------------------------------------------------------------------------
Private Function fncCPRead() As String
    Dim objIEApp As Object
    Dim strClipB As String
    Set objIEApp = CreateObject("HTMLfile")
    strClipB = objIEApp.ParentWindow.ClipboardData.GetData("text")
    fncCPRead = strClipB
    Set objIEApp = Nothing
End Function
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : ShellAndWait
' Author    : Case (Ralf Stolzenburg)
' Date      : 17.04.2013
' Purpose   : ShellAndWait mit ausgeblendetem Dosfenster...
'--------------------------------------------------------------------------
Private Sub ShellAndWait(ByVal strPathName As String)
   Dim WshShell As Object
   On Error GoTo Fin
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.Run strPathName, 0, True
Fin:
   Set WshShell = Nothing
   If Err.Number <> 0 Then MsgBox "Error: " & _
       Err.Number & " " & Err.Description
End Sub

16.04.2013

Internetexplorer - bestimmte Fenster schliessen - API...

Frage: Gestern haben wir versucht mittels "Shell" bestimmte Internetexplorerfenster zu beenden. Falls das - aus welchem Grund auch immer - nicht funktioniert, hier eine Möglichkeit per "API". Die Sub "Main_1" dient nur dazu den Internetexplorer mit bestimmten Seiten mehrmals zu starten.

Yesterday we tried using "shell" to terminate certain Internet Explorer window. If - for whatever reason - does not work, here's a way by "API". The Sub "Main_1" serves only to Internet Explorer with certain pages to start several times.

Hier noch eine Beispieldatei / Here's a sample file:
Internetexplorer - bestimmte Fenster schliessen - API...[XLS 50 KB]

Option Explicit
' Quelle: http://support.microsoft.com/kb/147659/en-us/
Private Declare Function GetParent Lib "user32" _
    (ByVal hwnd 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, _
    ByVal lParam 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 GetWindow Lib "user32" (ByVal hwnd As Long, _
    ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Const WM_CLOSE = &H10
' Das ist ein Teil der Caption des Internetexplorerfensters - anpassen!!!!
Const strSearch As String = "pur... - Windows Internet Explorer"
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 16.04.2013
' Purpose   : API - Bestimmtes Internetexplorer Fenster schliessen...
'--------------------------------------------------------------------------
Public Sub Main()
    Dim lngReturnValue As Long
    Dim strTMP As String * 256
    Dim lngHwnd As Long
    On Error GoTo Fin
    lngHwnd = FindWindow(vbNullString, vbNullString)
    Do While Not lngHwnd = 0
        If GetParent(lngHwnd) = 0 Then
            GetWindowText lngHwnd, strTMP, 256
            If InStr(strTMP, strSearch) > 0 Then
                lngReturnValue = PostMessage(lngHwnd, WM_CLOSE, 0&, 0&)
            End If
        End If
        lngHwnd = GetWindow(lngHwnd, GW_HWNDNEXT)
    Loop
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Public Sub Main_1()
    ' NUR zum testen. Der IE wird viermal aufgerufen
    ' Dreimal mit meiner Blogseite und einmal mit einem Excelforum
    On Error GoTo Fin
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://vbanet.blogspot.de/")
    Call IE_Run("http://www.herber.de/forum/")
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : IE_Run
' Author    : Case (Ralf Stolzenburg)
' Date      : 16.04.2013
' Purpose   : Internetexplorer mit bestimmten Seiten starten...
'--------------------------------------------------------------------------
Private Sub IE_Run(ByVal strAddress As String)
    Dim objIEApp As Object
    Set objIEApp = CreateObject("InternetExplorer.Application")
    With objIEApp
        .Navigate strAddress
        Do: Loop Until .Busy = False
        Do: Loop Until .Busy = False
        .Visible = True
    End With
    Set objIEApp = Nothing
End Sub

15.04.2013

Internetexplorer - bestimmte Fenster schliessen...

Frage: Ich möchte bestimmte Internetexplorer Fenster schließen. Es soll nach einem bestimmten String im Namen gesucht werden. Wie geht das?

Im ersten Code (Main) werden die Informationen zum Shell-Fenster im Direktfenster ausgegeben. Im zweiten Code (Main_1) per MsgBox. Im dritten Code (Main_2) werden alle Internetexplorer Fenster geschlossen, wenn mein Blog (Suchwort "Code") offen ist.


I want to close certain Internet Explorer window. It should be searched for a specific string in the name. How does it work?

The first code (Main), the information on the shell window will be printed in the Immediate window. The second code (Main_1) via MsgBox. The third code (Main_2) all Internet Explorer windows are closed, if my blog (search word "Code") is open.


Hier noch eine Beispieldatei / Here's a sample file:
Internetexplorer - bestimmte Fenster schliessen...[XLS 50 KB]


Option Explicit
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 15.04.2013
' Purpose   : Info über das Shell - Fenster - Debug.Print...
'--------------------------------------------------------------------------
Sub Main()
    Dim objWindow As Object
    Dim objShell As Object
    On Error GoTo Fin
    Set objShell = CreateObject("Shell.Application")
    For Each objWindow In objShell.Windows
        Debug.Print "LocationName: " & objWindow.LocationName
        Debug.Print "Name: " & objWindow.Name
        Debug.Print "LocationURL: " & objWindow.LocationURL
        Debug.Print "FullName: " & objWindow.FullName
        Debug.Print "Path: " & objWindow.Path
        Debug.Print vbCrLf
    Next objWindow
Fin:
    Set objShell = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main_1
' Author    : Case (Ralf Stolzenburg)
' Date      : 15.04.2013
' Purpose   : Info über das Shell - Fenster - MsgBox...
'--------------------------------------------------------------------------
Sub Main_1()
    Dim objWindow As Object
    Dim objShell As Object
    Dim strTMP As String
    On Error GoTo Fin
    Set objShell = CreateObject("Shell.Application")
    For Each objWindow In objShell.Windows
        strTMP = strTMP & "LocationName: " & objWindow.LocationName
        strTMP = strTMP & vbCrLf
        strTMP = strTMP & "Name: " & objWindow.Name
        strTMP = strTMP & vbCrLf
        strTMP = strTMP & "LocationURL: " & objWindow.LocationURL
        strTMP = strTMP & vbCrLf
        strTMP = strTMP & "FullName: " & objWindow.FullName
        strTMP = strTMP & vbCrLf
        strTMP = strTMP & "Path: " & objWindow.Path
        strTMP = strTMP & vbCrLf & vbCrLf
    Next objWindow
    If strTMP <> "" Then
        MsgBox strTMP
    Else
        MsgBox "Shell - no associated window open!"
    End If
Fin:
    Set objShell = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main_2
' Author    : Case (Ralf Stolzenburg)
' Date      : 15.04.2013
' Purpose   : Bestimmtes Internet Explorer Fenster (Name) schliessen...
'--------------------------------------------------------------------------
Sub Main_2()
    Dim objWindow As Object
    Dim objShell As Object
    On Error GoTo Fin
    Set objShell = CreateObject("Shell.Application")
    For Each objWindow In objShell.Windows
        If objWindow.LocationName Like "*" & "Code" & "*" Then objWindow.Quit
    Next objWindow
Fin:
    Set objShell = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...