Diskette kopieren anhand des Windows-Dialoges "Diskette kopieren"

.Beschreibung
Das nachstehende VBA-Codebeispiel öffnet das Dialogfenster "Diskette kopieren". Es handelt sich um einen Standarddialog von Windows, der im Windows Explorer über den Menübefehl "Diskette kopieren" aufgerufen werden kann. Mit diesem Dialog können Sie eine Kopie einer beliebigen Diskette erstellen.

Der Programmcode kann ausgeführt werden (d.h. der Dialog angezeigt werden), ohne dass sich eine Diskette im Diskettenlaufwerk befinden muss.

.VBA-Code
Public Sub ShowDiskCopyDialog()
  Shell "rundll32.exe diskcopy.dll,DiskCopyRunDll 0,0", vbNormalFocus
End Sub

	Verwandte Codebeispiele
	Datenträger/Laufwerk kopieren

	Weitere Informationen
	VBA-Befehle und -Funktionen

Diskette formatieren anhand des Windows-Dialoges "Diskette formatieren"

.Beschreibung
Mit diesem Programmcode können Sie eine Diskette anhand des Windows-Dialoges "Diskette formatieren" formatieren. Bitte beachten Sie, dass beim Ausführen des Programmcodes (d.h. für das Öffnen des Dialogfensters) eine Diskette im Diskettenlaufwerk eingelegt sein muss. Anderenfalls erscheint die Fehlermeldung "Es befindet sich kein Datenträger in Laufwerk A:", die vom Benutzer bestätigt werden muss. Das VBA-Programm läuft jedoch ungeachtet dessen weiter, d.h. auch ohne dass die Fehlermeldung bestätigt wurde.

.VBA-Code
Public Sub ShowDiskFormatDialog()
  Shell "rundll32.exe shell32.dll,SHFormatDrive", vbNormalFocus
End Sub

	Weitere Informationen
	VBA-Befehle und -Funktionen

Add-In beim Öffnen einer Arbeitsmappe automatisch laden

.Beschreibung
Das nachfolgende Codebeispiel zeigt, wie ein Add-In beim Öffnen einer Arbeitsmappe explizit geladen wird. Damit wird erreicht, dass das Add-In automatisch verfügbar gemacht wird, sobald der Benutzer eine bestimmte Arbeitsmappe öffnet. Beim Schliessen der Mappe wird das Add-In wieder entladen.

.VBA-Code
'Modul 'DieseArbeitsmappe'
Private Sub Workbook_Open()
  Application.AddIns("Mein AddIn").Installed = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.AddIns("Mein AddIn").Installed = False
End Sub

.Hinweis
Add-Ins werden gewöhnlich mappenunabhängig geladen und entladen und stehen somit allen in einer Excel-Instanz geöffneten Arbeitsmappen zur Verfügung. Durch obigen VBA-Code kann ein Add-In quasi an eine bestimmte Arbeitsmappe 'gebunden' werden.

	Weitere Informationen
	Add-Ins

E-Mail-Formular öffnen und Betreff (Subject) und Mitteilung (Body) vorblenden

.Beschreibung
Es existiert eine ganze Reihe verschiedener Möglichkeiten, wie man aus einem VBA/VB-Programm heraus eine E-Mail versenden kann. Die einfachste Variante ist die Verwendung der SendMail-Methode (Application-Objekt). Leider ist diese Lösung nicht sehr flexibel. Den Betreff ("Subject") kann man zwar angegeben, jedoch keinen Mitteilungstext ("Body"). Zudem gibt es keine Möglichkeiten zum Festlegen der CC-Empfänger ("Carbon Copy"; Empfänger einer Kopie) und BCC-Empfänger ("Blind Carbon Copy"; Empfänger einer Blindkopie).

Wenn zum Öffnen des E-Mail-Formulares stattdessen die Run-Methode des Shell-Objektes aus der "Windows Script Host"-Bibliothek benutzt wird, kann man Empfänger, CC-Empfänger, BCC-Empfänger, Betreff und Mitteilung vorgeben.

.VBA-Code
Sub ShowMailForm()
  CreateObject("WScript.Shell").Run """mailto:support@pc-help.com?cc=itsupport@company.ch;management@company.ch" & _
      "&bcc=philipp@company.ch&subject=Dringendes PC-Problem&body=Folgender Fehler ist aufgetreten:"""
End Sub

.Hinweis
Bitte beachten Sie, dass das gesamte Argument in dreifachen Anführungszeichen geschrieben werden muss, sobald die Zeichenfolge ein Leerzeichen enthält. Es wird empfohlen, generell drei Anführungszeichen zu verwenden, also auch dann, wenn kein Leerzeichen vorhanden ist.

Eingerichtete Drucker auflisten (inkl. Angabe des Druckerports)

.Beschreibung
Dieses Codebeispiel zeigt, wie man die in Windows eingerichteten Drucker abfragen kann. Die Drucker werden nacheinander mit Angabe des Druckerports und des Druckernamens in einem Dialogfeld ausgegeben.

Bitte beachten Sie, dass als Port der Name des Anschlusses angezeigt wird, welcher vom Drucker benutzt wird. Dieser muss nicht zwingend mit dem (internen) Namen des Ports übereinstimmen. Beispielsweise wird beim Acrobat Distiller als Druckerport der Pfad "C:\WINNT\Profiles\All Users\Desktop\*.pdf" ausgegeben, anstelle des internen Portnamens "Ne00:".

.VBA-Code
Public Sub ShowPrinterConnections()
  Dim lngItem As Long
  Dim objWSHNetwork As Object
  Dim objWSHCollection As Object
  Set objWSHNetwork = CreateObject("WScript.Network")
  Set objWSHCollection = objWSHNetwork.EnumPrinterConnections
  For lngItem = 0 To objWSHCollection.Count - 1 Step 2
    MsgBox "Drucker Nr. " & CStr(lngItem / 2 + 1) & ":" & vbCrLf & objWSHCollection(lngItem) & " " & objWSHCollection(lngItem + 1)
  Next lngItem
  Set objWSHCollection = Nothing
  Set objWSHNetwork = Nothing
End Sub

	Verwandte Codebeispiele
	Eingerichtete Drucker mit zusätzlichen Informationen auflisten

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Eingerichtete Drucker mit zusätzlichen Informationen auflisten

.Beschreibung
Das nachfolgende Codebeispiel erstellt eine Liste der eingerichteten Windows-Drucker auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe.

Zuerst werden die vorhandenen Drucker ermittelt und in einer Datenfeldvariable (astrPrinters) abgelegt. Anschliessend wird der Arbeitsmappe ein neues Tabellenblatt hinzugefügt und die Überschriften der Listenspalten eingetragen. Zu jedem Drucker werden in der Windows Registry Informationen wie unter anderem Druckertreiber, Beschreibung, Ort, Dateiname der Trennseite und Freigabename nachgesehen und aufgelistet.

.VBA-Code
Public Sub ListPrintersWithProperties()
  Const RegKey As String = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Printers\"
  Dim lngItem As Long
  Dim astrPrinters() As String
  Dim wksSheet As Worksheet
  Dim objWSHShell As Object
  Dim objWSHNetwork As Object
  Dim objWSHCollection As Object
  Set objWSHNetwork = CreateObject("WScript.Network")
  Set objWSHCollection = objWSHNetwork.EnumPrinterConnections
  For lngItem = 0 To objWSHCollection.Count - 1 Step 2
    ReDim Preserve astrPrinters(lngItem / 2 + 1)
    astrPrinters(lngItem / 2 + 1) = objWSHCollection(lngItem + 1)
  Next lngItem
  Set objWSHShell = CreateObject("WScript.Shell")
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Range("A1:N1").Value = Array("Drucker", "Druckertreiber", "Kommentar", "Default-Priorität", _
       "Priorität", "Standort", "Anschluss", "Trennseite", "Freigabename", "Spool-Verzeichnis", _
       "Druckprozessor", "Standard-Datentyp", "Status")
    .Range("A1:N1").Font.Bold = True
    For lngItem = 1 To UBound(astrPrinters)
      .Cells(lngItem + 1, 1).Value = astrPrinters(lngItem)
      .Cells(lngItem + 1, 2).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Printer Driver")
      .Cells(lngItem + 1, 3).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Description")
      .Cells(lngItem + 1, 4).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Default Priority")
      .Cells(lngItem + 1, 5).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Priority")
      .Cells(lngItem + 1, 6).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Location")
      .Cells(lngItem + 1, 7).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Port")
      .Cells(lngItem + 1, 8).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Separator File")
      .Cells(lngItem + 1, 9).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Share Name")
      .Cells(lngItem + 1, 10).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\SpoolDirectory")
      .Cells(lngItem + 1, 11).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Print Processor")
      .Cells(lngItem + 1, 12).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Datatype")
      .Cells(lngItem + 1, 13).Value = objWSHShell.RegRead(RegKey & astrPrinters(lngItem) & "\Status")
    Next lngItem
    .Range("A:N").EntireColumn.AutoFit
    .Range("A1").Sort Key1:=wksSheet.Range("A1"), Order1:=xlAscending, Header:=xlYes
  End With
  Set objWSHCollection = Nothing
  Set objWSHNetwork = Nothing
  Set objWSHShell = Nothing
  Set wksSheet = Nothing
End Sub

	Verwandte Codebeispiele
	Eingerichtete Drucker auflisten (inkl. Angabe des Druckerports)

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Meldungsdialog nach x Sekunden automatisch schliessen

.Beschreibung
Hier wird eine Möglichkeit vorgestellt, wie auf sehr einfache Art und Weise ein Dialogfeld für eine festgelegte Zeitdauer eingeblendet werden kann. Mit der gewöhnlichen MsgBox-Anweisung (bzw. MsgBox-Funktion) lässt sich dies nicht bewerkstelligen, da das Dialogfenster erst geschlossen wird, wenn der Benutzer eine Schaltfläche anklickt.

In den Codebeispielen weiter unten wird die Meldung für 5 Sekunden eingeblendet (siehe Popup-Parameter mit der Zahl 5 im VBA-Code). Die Syntax der Popup-Methode ist derjenigen der MsgBox-Anweisung von VBA ähnlich; nur die Reihenfolge der Argumente ist unterschiedlich.

Syntax
Mit Auswerten der gewählten Schaltfläche:
x = Object.Popup(bstrText As String, [pvarSecondsToWait], [pvarTitle], [pvarType]) As Long

Ohne Auswerten der gewählten Schaltfläche:
Object.Popup bstrText As String, [pvarSecondsToWait], [pvarTitle], [pvarType]

Argumente
Diese Argumente werden von Popup verwendet:

» Im ersten Codebeispiel wird der übliche Weg verwendet: Objektvariable deklarieren, Objektreferenz mit Set zuweisen, Objektmethode aufrufen, Objektvariable aus dem Speicher entfernen.

» Das zweite Beispiel zeigt die abgekürzte Variante ohne Benutzung einer Objektvariable.

» Das Beispiel #3 verwendet ebenfalls die Variante ohne Objektvariable, wobei zusätzlich der von Popup zurückgegebene Wert ausgewertet wird.

.VBA-Code #1
Sub ShowPopupMessage1()
  Dim objWSHShell As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  objWSHShell.Popup "Dies ist ein WSH-Popup!", 5, "Dialog-Titel", 64
  Set objWSHShell = Nothing
End Sub

.VBA-Code #2
Sub ShowPopupMessage2()
  CreateObject("WScript.Shell").Popup "Dies ist ein WSH-Popup!", 5, "Dialog-Titel", 64
End Sub

.VBA-Code #3
Sub ShowPopupMessage3()
  If CreateObject("WScript.Shell").Popup("Weiterfahren?", 3, "Ablauf", vbYesNo + vbQuestion) = vbYes Then
    MsgBox "Benutzer hat 'Ja' geklickt."
  Else
    MsgBox "Benutzer hat 'Nein' geklickt oder nicht geantwortet."
  End If
End Sub

.Hinweis
Es ist auch möglich, die Benutzer-Reaktion genauer auszuwerten. Alles zu diesem Thema erfahren Sie hier:

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Prüfen, ob eine Arbeitsmappe gerade gespeichert/geöffnet wird

.Beschreibung
Dieses Codebeispiel zeigt, wie man kontrollieren kann, ob eine bestimmte Arbeitsmappe gerade gespeichert beziehungsweise geöffnet wird.

Im Beispiel wird die Arbeitsmappendatei "C:\Daten\EineMappe.xls" verwendet.

.VBA-Code
Public Sub CheckFileOperation()
  Const strFile As String = "C:\Daten\EineMappe.xls"
  On Error Resume Next
  Open strFile For Binary Access Read Lock Read As #1
  If Err.Number = 70 Then
    Err.Clear
    Open strFile For Binary Access Read As #1
    If Err.Number = 70 Then
      MsgBox "Die Datei wird momentan gespeichert oder geöffnet."
    Else
      MsgBox "Die Datei wird bearbeitet aber momentan nicht gespeichert/geöffnet."
    End If
  Else
    MsgBox "Die Datei wird nicht bearbeitet und somit momentan nicht gespeichert/geöffnet."
  End If
  Close #1
End Sub

Prüfen, ob ein VBA-Projekt noch nicht gespeicherte Änderungen besitzt

.Beschreibung
Anhand der Saved-Eigenschaft kann man überprüfen, ob ein VBA-Projekt Änderungen enthält, die noch nicht gespeichert wurden.

Das Setzen der Saved-Eigenschaft auf True ist nicht möglich. Bei einer Arbeitsmappe ist dies dagegen möglich.

Eine Änderung im VBA-Projekt setzt sowohl die Saved-Eigenschaft des Projektes als auch der Mappe auf False. Eine Änderung in der Arbeitsmappe setzt dagegen in den meisten Fällen nur die Saved-Eigenschaft der Mappe auf False - die Saved-Eigenschaft des VBA-Projektes enthält weiterhin True. Nur wenn die Mappen-Änderung einen Einfluss auf das Projekt hat, genauer gesagt auf die Projekt-Struktur, also die Module, so wird auch Saved des Projektes auf False gesetzt. Dies ist beispielsweise bei Hinzufügen oder Löschen eines Arbeitsblattes der Fall, weil dadurch ein neues (Blatt-)Modul hinzukommt bzw. wegfällt.

.VBA-Code #1
Public Sub CheckUnsavedProjectChanges1()
  If Application.VBE.ActiveVBProject.Saved = False Then
    MsgBox "Das VBA-Projekt besitzt noch nicht gespeicherte Änderungen."
  Else
    MsgBox "Das VBA-Projekt besitzt keine noch nicht gespeicherten Änderungen."
  End If
End Sub

.VBA-Code #2
Public Sub CheckUnsavedProjectChanges2()
  If ActiveWorkbook.VBProject.Saved = False Then
    MsgBox "Das VBA-Projekt besitzt noch nicht gespeicherte Änderungen."
  Else
    MsgBox "Das VBA-Projekt besitzt keine noch nicht gespeicherten Änderungen."
  End If
End Sub

Anzahl aktuelle Bearbeiter einer freigegebenen Arbeitsmappe ermitteln

.Beschreibung
Anhand der UserStatus-Eigenschaft von Workbook kann man herausfinden, wie viele Benutzer aktuell mit der aktiven, freigegebenen Arbeitsmappe arbeiten.

UserStatus ist ein zweidimensionales Datenfeld, wobei die zweite Dimension immer drei Elemente enthält.

Es tritt kein Laufzeitfehler auf, wenn die Arbeitsmappe nicht freigegeben ist oder die Verbindung zur Mappe abgebrochen ist.

.VBA-Code
Public Sub GetNumberOfCurrentWorkbookUsers()
  MsgBox UBound(ActiveWorkbook.UserStatus)
End Sub

Aktuelle Bearbeiter einer freigegebenen Arbeitsmappe auflisten

.Beschreibung
Dieses Codebeispiel zeigt, ...

UserStatus ist ein zweidimensionales Array, wobei die zweite Dimension immer die drei Elemente Benutzername, Datum/Zeit des Mappenöffnens und Dateizugriffsmodus enthält.

Listet die aktuellen Bearbeiter der aktiven (freigegebenen) Arbeitsmappe auf einem Arbeitsblatt einer neuen Arbeitsmappe auf. Es wird absichtlich eine neue Arbeitsmappe verwendet, da man einer freigegebenen Arbeitsmappe grundsätzlich kein neues Blatt hinzufügen kann. Diese Funktionalität ist für freigegebene Mappen gesperrt (Anmerkung des Autors: Allerdings ist es nur über die Excel Benutzeroberfläche nicht möglich. Mit VBA würde es problemlos gehen.)

.VBA-Code
Public Sub ListCurrentWorkbookUsers()
  Dim intCounter As Integer
  Dim wkbBook As Workbook
  Dim wkbReport As Workbook
  Set wkbBook = ActiveWorkbook
  Set wkbReport = Workbooks.Add(Template:=xlWBATWorksheet)
  With wkbReport.Worksheets(1)
    For intCounter = 1 To UBound(wkbBook.UserStatus)
      .Cells(intCounter, 1).Value = wkbBook.UserStatus(intCounter, 1)
      .Cells(intCounter, 2).Value = wkbBook.UserStatus(intCounter, 2)
      .Cells(intCounter, 3).Value = wkbBook.UserStatus(intCounter, 3)
    Next intCounter
    .Range("A:C").EntireColumn.AutoFit
  End With
  Set wkbReport = Nothing
  Set wkbBook = Nothing
End Sub

Bisherige Bearbeiter einer freigegebenen Arbeitsmappe auflisten

.Beschreibung
Es gibt eine Möglichkeit herauszufinden, wie die Namen der Benutzer lauten, die jemals mit einer bestimmten freigegebenen Arbeitsmappe gearbeitet haben.

Listet die aktuellen Bearbeiter der aktiven (freigegebenen) Arbeitsmappe auf einem Arbeitsblatt einer neuen Arbeitsmappe auf.

Vier Spalten: Nummer, Benutzername, Druckereinstellungen und Filtereinstellungen.

Für jeden neuen Bearbeiter erstellt Excel automatisch eine persönliche Ansicht. Die Erstellung erfolgt, sobald der neue Benutzer die Arbeitsmappe zum ersten Mal speichert.

Fehlermeldung "Einige Ansichten-Einstellungen können nicht angewendet werden".

.VBA-Code
Public Sub ListAllWorkbookUsers()
  Dim intViews As Integer
  Dim intCustomViews As Integer
  Dim wkbBook As Workbook
  Dim wkbReport As Workbook
  On Error Resume Next
  Set wkbBook = ActiveWorkbook
  Set wkbReport = Workbooks.Add(Template:=xlWBATWorksheet)
  With wkbReport.Worksheets(1)
    .Range("A1:D1").Value = Array("Nr.", "Benutzername", "Drucker", "Filter")
    .Range("A1:D1").Font.Bold = True
    For intViews = 1 To wkbBook.CustomViews.Count
      .Cells(intViews - intCustomViews + 1, 1).Value = intViews - intCustomViews
      .Cells(intViews - intCustomViews + 1, 2).Value = wkbBook.CustomViews(intViews).Name
      If Err.Number = 0 Then
        If Right$(wkbBook.CustomViews(intViews).Name, 22) = " - Persönliche Ansicht" Then
          .Cells(intViews - intCustomViews + 1, 2).Value = Left$(wkbBook.CustomViews(intViews).Name, _
             Len(wkbBook.CustomViews(intViews).Name) - 22)
          .Cells(intViews - intCustomViews + 1, 3).Value = wkbBook.CustomViews(intViews).PrintSettings
          .Cells(intViews - intCustomViews + 1, 4).Value = wkbBook.CustomViews(intViews).RowColSettings
        Else
          .Cells(intViews - intCustomViews + 1, 1).Value = ""
          .Cells(intViews - intCustomViews + 1, 2).Value = ""
          intCustomViews = intCustomViews + 1
        End If
      Else
        .Cells(intViews - intCustomViews + 1, 2).Value = "(Benutzername nicht verfügbar)"
        Err.Clear
      End If
    Next intViews
    .Range("A:D").EntireColumn.AutoFit
  End With
  Set wkbReport = Nothing
  Set wkbBook = Nothing
End Sub

	Verwandte Codebeispiele
	Persönliche Ansichten anderer Bearbeiter einer freigegebenen Arbeitsmappe löschen

Anderer Bearbeiter einer freigegebenen Arbeitsmappe entfernen

.Beschreibung
Man kann sich selber nicht entfernen. Die Arbeitsmappe muss somit von mindestens zwei Benutzern bearbeitet werden, damit man einen anderen Benutzer entfernen kann.

Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler", wenn die Arbeitsmappe nicht freigegeben ist.

Laufzeitfehler 1004 "Sie sind nicht mehr mit dieser Datei verbunden. Unter Umständen hat ein anderer Benutzer Sie von dieser Datei getrennt oder die Datei überschrieben."

Der Index für die bei RemoveUser anzugebenden Benutzernummer beginnt bei 1.

UserStatus-Eigenschaft (zweidimensionales Datenfeld)

Der Inhalt von UserStatus wird bei jedem Zugriff auf diese Eigenschaft neu ermittelt.

.VBA-Code
Public Sub RemoveWorkbookUser()
  ActiveWorkbook.RemoveUser Index:=1
End Sub

	Verwandte Codebeispiele
	Anderer Bearbeiter einer freigegebenen Arbeitsmappe entfernen

Persönliche Ansichten anderer Bearbeiter einer freigegebenen Arbeitsmappe löschen

.Beschreibung
Für jeden Bearbeiter einer freigegebenen Arbeitsmappe wird eine eigene Ansicht benutzt. Microsoft Excel legt eine solche persönliche Ansicht automatisch an, sobald ein Benutzer die Arbeitsmappe das erste Mal öffnet und eine Änderung vornimmt. Das Problem dieser persönlichen Ansichten ist, dass sie - einmal erstellt - für immer in der Arbeitsmappe liegen bleiben. Excel kann ja nicht wissen, ob ein bestimmter Benutzer noch mal mit der Mappe arbeiten wird. Hinzu kommt, dass beim Aufheben der Arbeitsmappen-Freigabe die persönlichen Ansichten ebenfalls nicht entfernt werden. Daher muss man sie von Hand oder mittels VBA-Programm löschen.

Es spielt keine Rolle, ob zum Zeitpunkt der VBA-Codeausführung die Arbeitsmappe tatsächlich freigegeben ist.

Der Inhalt von UserStatus wird bei jedem Zugriff auf diese Eigenschaft neu ermittelt.

.VBA-Code
Public Sub RemoveCustomViews()

End Sub

	Verwandte Codebeispiele
	Anderer Bearbeiter einer freigegebenen Arbeitsmappe entfernen Bisherige Bearbeiter einer freigegebenen Arbeitsmappe auflisten

Prüfen, ob eine freigegebene Arbeitsmappe noch verbunden ist

.Beschreibung
So lange man eine freigegebene Arbeitsmappe bearbeitet, besteht eine Verbindung zur Arbeitsmappendatei. Diese Verbindung kann aus verschiedenen Gründen abgebrochen werden.

Laufzeitfehler 1004 "Sie sind nicht mehr mit dieser Datei verbunden. Unter Umständen hat ein anderer Benutzer Sie von dieser Datei getrennt oder die Datei überschrieben."

Wenn beim Abfragen von "UserStatus(1, 1)" kein Fehler auftritt, ist man mit der Arbeitsmappe verbunden.

.VBA-Code
Public Sub CheckWorkbookConnection()
  On Error Resume Next
  If ActiveWorkbook.UserStatus(1, 1) = "" Then
    MsgBox "Nicht mehr mit der Arbeitsmappe verbunden!", vbExclamation
  End If
End Sub

	Verwandte Codebeispiele
	Anderer Bearbeiter einer freigegebenen Arbeitsmappe entfernen

Freigegebene Arbeitsmappe exklusiv öffnen

.Beschreibung
Manchmal wäre es sinnvoll, eine freigegebene Arbeitsmappe exklusiv zu öffnen. Also genau so, wie es bei gewöhnlichen, d.h. nicht freigegebenen Arbeitsmappen der Fall ist, sodass nur ein einzelner Benutzer die Mappe bearbeiten kann. Das exklusive Öffnen einer freigegebenen Arbeitsmappe ist jedoch nicht direkt möglich. Es geht nur auf indirektem Weg: Man muss zuerst wie gewohnt die Mappe öffnen und anschliessend den Zugriffsmodus auf "Exklusiv" ändern.

Bitte beachten Sie, dass auf diese Weise die Freigabe der Arbeitsmappe aufgehoben und andere Benutzer von der Datei getrennt werden. Zudem wird das Änderungsprotokoll gelöscht.

.VBA-Code #1
Public Sub OpenSharedWorkbookExclusive1()
  Workbooks.Open "C:\Daten\Freigegeben.xls"
  ActiveWorkbook.ExclusiveAccess
End Sub

.VBA-Code #2
Public Sub OpenSharedWorkbookExclusive2()
  Dim wkbWorkbook As Workbook
  Set wkbWorkbook = Workbooks.Open("C:\Daten\Freigegeben.xls")
  If wkbWorkbook.MultiUserEditing Then
    wkbWorkbook.ExclusiveAccess
  Else
    MsgBox "Die Arbeitsmappe ist nicht freigegeben und somit bereits exklusiv geöffnet.", vbInformation
  End If
  Set wkbWorkbook = Nothing
End Sub

	Verwandte Codebeispiele
	Anderer Bearbeiter einer freigegebenen Arbeitsmappe entfernen

Prüfen, ob eine geschlossene Arbeitsmappe freigegeben ist

.Beschreibung
Hier wird gezeigt, wie man überprüfen kann, ob eine Arbeitsmappe freigegeben ist, welche nicht in der aktuellen Excel-Sitzung geöffnet ist.

Noch keine Lösung gefunden!

.VBA-Code
Public Sub CheckWorkbookSharing()

End Sub

	Verwandte Codebeispiele
	Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigegeben ist

Datei im Windows Explorer anzeigen

.Beschreibung
Die nachfolgenden Codebeispiele zeigen, wie man den Windows Explorer öffnen kann und in der Dateiliste des Explorer-Fensters eine bestimmte Datei markiert wird.

Der Schalter "/select" legt fest, dass eine Datei (oder ein Ordner) selektiert werden soll.

Bitte beachten Sie, dass nach jedem Schalter ein Komma stehen muss.

» Beispiel #1: Ordneransicht. Ohne Schalter "/e".

» Beispiel #2: Baumansicht. Mit Schalter "/e".

.VBA-Code #1
Public Sub ShowWindowsExplorer1()
  Shell "Explorer.exe /select, C:\Daten\EineMappe.xls", vbNormalFocus
End Sub

.VBA-Code #2
Public Sub ShowWindowsExplorer2()
  Shell "Explorer.exe /e, /select, C:\Daten\EineMappe.xls", vbNormalFocus
End Sub

.Hinweis
Wird eine nicht vorhandene Datei angegeben, so erscheint die Fehlermeldung "Der Pfad <x> ist nicht vorhanden oder verweist auf kein Verzeichnis". Diese Meldung wird nicht von VBA bzw. dem VBA-Editor angezeigt, sondern vom Windows Explorer. Das bedeutet, dass kein Laufzeitfehler auftritt, welchen man abfangen könnte. Nach Bestätigen der Fehlermeldung mit OK wird der Explorer nicht gestartet bzw. dadurch wieder beendet. Es wird kein Explorer-Fenster geöffnet. Bitte beachten Sie auch, dass, wenn Sie Shell als Funktion verwenden, eine Task-ID zurückgegeben wird, die so lange gültig ist, bis die Fehlermeldung bestätigt wird.

	Verwandte Codebeispiele
	Ordner im Windows Explorer anzeigen

	Weitere Informationen
	VBA-Befehle und -Funktionen

Papierkorb von Windows leeren

.Beschreibung
Noch keine Lösung gefunden!

.VBA-Code
Public Sub EmptyPaperBin()

End Sub

Stammverzeichnis eines Laufwerkes abfragen

.Beschreibung
Jedes Laufwerk besitzt ein so genanntes Stammverzeichnis, auch Stammordner genannt.

» Codebeispiel #1: Gibt "C:\" zurück.

» Codebeispiel #2: Gibt "C:" zurück.

.VBA-Code #1
Public Sub GetRootDirectory1()
  MsgBox CreateObject("Scripting.FileSystemObject").GetDrive("C").RootFolder
End Sub

.VBA-Code #2
Public Sub GetRootDirectory2()
  MsgBox CreateObject("Scripting.FileSystemObject").GetDrive("C").Path
End Sub

.Hinweis
Wenn das angegebene Laufwerk nicht vorhanden ist, erscheint der Laufzeitfehler 68 "Gerät nicht verfügbar". Ist das angegebene Laufwerk nicht bereit (z.B. keine Diskette in Diskettenlaufwerk eingelegt), tritt der Laufzeitfehler 76 "Pfad nicht gefunden" auf. Letzterer Laufzeitfehler ist übrigens ungewöhnlich, da normalerweise der Laufzeitfehler 71 "Datenträger nicht bereit" erscheint, wenn sich keine Diskette im Laufwerk befindet.

Typ eines Laufwerkes abfragen

.Beschreibung
Der Laufwerkstyp ist in verschiedenen Situationen nützlich.

Meldungstext: "Es befindet sich keine Diskette im Diskettenlaufwerk A:" oder "Die Festplatte C: ist voll".

Symbol: Entsprechendes Laufwerk-Symbol anzeigen.

Lesen/Schreiben: Speichern auf CD-ROM nicht möglich. Öffnen einer Mappe von Diskette nicht zu empfehlen.

Tabelle der Werte von DriveType und GetDriveType:

.VBA-Code #1
Public Sub GetDriveType1()
  MsgBox CreateObject("Scripting.FileSystemObject").GetDrive("C:").DriveType
End Sub

.VBA-Code #2
Public Sub GetDriveType2()
  Dim intDriveType As Integer
  Dim strDriveType As String
  Dim strDrive As String
  strDrive = "C:"
  intDriveType = CreateObject("Scripting.FileSystemObject").GetDrive(strDrive).DriveType
  Select Case intDriveType
    Case 0
      strDriveType = "Unbekannt"
    Case 1
      strDriveType = "Wechselplatte/Diskette"
    Case 2
      strDriveType = "Festplatte"
    Case 3
      strDriveType = "Netzwerk"
    Case 4
      strDriveType = "CD-ROM-Laufwerk"
    Case 5
      strDriveType = "RAM-Disk"
  End Select
  MsgBox "Der Typ von Laufwerk " & strDrive & " ist " & strDriveType & ".", vbInformation
End Sub

.VBA-Code #3
'Deklarationsbereich
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

'Codemodul
Public Sub GetDriveType3()
  Dim intDriveType As Integer
  Dim strDrive As String
  strDrive = "C:\"
  intDriveType = GetDriveType(strDrive)
  If intDriveType = 2 Then
    MsgBox "Diskettenlaufwerk"
  ElseIf intDriveType = 3 Then
    MsgBox "Festplatte"
  ElseIf intDriveType = 5 Then
    MsgBox "CD-ROM"
  End If
End Sub

	Verwandte Codebeispiele
	Prüfen, ob ein Laufwerk ein CD-ROM Laufwerk ist

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Laufwerk-Eigenschaft ändern

.Beschreibung
Dieses Codebeispiel zeigt, wie man eine Eigenschaft eines Laufwerkes ändern kann. Gewöhnlich kann man allerdings nur eine einzige Eigenschaft ändern, nämlich die so genannte Datenträger-Bezeichnung (Volume-Name). Andere Eigenschaften wie Laufwerktyp oder Freigabename (Share-Name) sind schreibgeschützt.

.VBA-Code
Public Sub SetDriveProperty()

End Sub

Ordner-Eigenschaft abfragen

.Beschreibung
Jeder Ordner besitzt mehrere Eigenschaften, die man ohne weiteres abfragen kann. Zu diesen Eigenschaften gehören unter anderem das Erstellt am-Datum und der Ordnertyp. Auch Ordner-Eigenschaften, die sozusagen dynamisch ermittelt werden, können abgefragt werden. Dazu gehört beispielsweise die Ordnergrösse, die Anzahl Unterordner und die Anzahl Dateien des Ordners.

.VBA-Code
Public Sub GetFolderProperty()

End Sub

Ordnerstruktur erstellen

.Beschreibung
Zum Anlegen von mehreren Ordnern, die ihrerseits Unterordner enthalten können, benötigt man ein bisschen mehr Programmcode als gewohnt.

Komplette Struktur erstellen (mehrere Ordner mit Unterordnern).

Programmcode: TODO

.VBA-Code
'Codemodul
Public Function SearchList(Filename As String, StartPath As String, FolderList As Collection) As Long
  Dim SubFolderList As New Collection
  Dim strResult As String
  Dim lngCounter As Long
  On Error Resume Next
  If Right(StartPath, 1) <> "\" Then
    StartPath = StartPath & "\"
  End If
  strResult = Dir(StartPath & Filename, vbDirectory)
  Do While strResult <> ""
    If strResult <> "" Then
      If GetAttr(StartPath & strResult) And vbDirectory Then
        If strResult <> "." And strResult <> ".." Then
          FolderList.Add StartPath & strResult, StartPath & strResult
        End If
      End If
    End If
    strResult = Dir()
  Loop
  strResult = Dir(StartPath & "*", vbDirectory)
  Do While strResult <> ""
    If GetAttr(StartPath & strResult) And vbDirectory Then
      If strResult <> "." And strResult <> ".." Then
        SubFolderList.Add StartPath & strResult, strResult
      End If
    End If
    strResult = Dir()
  Loop
  For lngCounter = 1 To SubFolderList.Count
    SearchList Filename, SubFolderList(lngCounter), FolderList
  Next lngCounter
  SearchList = FolderList.Count
End Function

'*** Aufruf ***
Public Sub CreateFolderTree()
  Dim colList As New Collection
  Dim lngCounter As Long
  Dim astrFolders() As String
  Const strBasePath As String = "C:\Daten"
  For lngCounter = 1 To SearchList("*", strBasePath, colList)
    ReDim Preserve astrFolders(1 To lngCounter)
    astrFolders(lngCounter) = Right$(colList(lngCounter), Len(colList(lngCounter)) - Len(strBasePath) - 1)
  Next lngCounter
End Sub

Programm starten und warten, bis es beendet wurde

.Beschreibung
Dieses Codebeispiel startet ein Programm und wartet so lange, bis es beendet wurde.

.VBA-Code
'Deklarationsbereich
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _
  lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
  ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103

'Codemodul
Public Sub RunProgramAndWait(ByVal strProgram As String)
  Dim hwndShell As Long
  Dim hwndProzess As Long
  Dim lngActive As Long
  hwndShell = Shell(strProgram, vbNormalFocus)
  hwndProzess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, hwndShell)
  Do
    GetExitCodeProcess hwndProzess, lngActive
    Sleep 100
    DoEvents
  Loop While lngActive = STILL_ACTIVE
End Sub

'*** Aufruf ***
Sub TestCall()
  Call RunProgramAndWait("Notepad.exe")
  MsgBox "Das Programm wurde beendet."
End Sub

	Verwandte Codebeispiele
	Anwendung starten und Makroausführung anhalten Programm starten und warten, bis es beendet oder die Esc-Taste gedrückt wurde Programm mit einer bestimmten Prozess-Basispriorität starten

	Weitere Informationen
	VBA-Befehle und -Funktionen

Programm starten und warten, bis es beendet oder die Esc-Taste gedrückt wurde

.Beschreibung
Dieses Codebeispiel zeigt, wie ein Programm gestartet und dann so lange gewartet wird, bis das Programm entweder beendet wurde oder der Benutzer die Esc-Taste gedrückt hat.

Als Beispiel wird der Windows Editor (Notepad) gestartet.

.VBA-Code
'Deklarationsbereich
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _
  lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
  ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

'Codemodul
Public Function RunProgramAndWait(ByVal strProgram As String) As Boolean
  Dim hwndShell As Long
  Dim hwndProzess As Long
  Dim lngActive As Long
  hwndShell = Shell(strProgram, vbNormalFocus)
  hwndProzess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, hwndShell)
  Do
    GetExitCodeProcess hwndProzess, lngActive
    Sleep 100
    If Abs(GetKeyState(27) < 0) Then
      RunProgramAndWait = True
      Exit Do
    End If
    DoEvents
  Loop While lngActive = STILL_ACTIVE
End Function

'*** Aufruf ***
Sub TestCall()
  If RunProgramAndWait("Notepad.exe") = False Then
    MsgBox "Das Programm wurde beendet."
  Else
    MsgBox "Die Esc-Taste wurde gedrückt."
  End If
End Sub

	Verwandte Codebeispiele
	Anwendung starten und Makroausführung anhalten Programm starten und warten, bis es beendet wurde Programm mit einer bestimmten Prozess-Basispriorität starten

	Weitere Informationen
	VBA-Befehle und -Funktionen

Programm mit einer bestimmten Prozess-Basispriorität starten

.Beschreibung
Windows-Programme bzw. -Prozesse werden standardmässig mit der Priorität "Normal" ausgeführt. Die Priorität ist unter anderem im Windows Task-Manager ersichtlich.

Mit dem folgenden VBA-Code können Sie ein Programm starten und dabei die zu verwendende Basispriorität angeben.

.VBA-Code
'Deklarationsbereich
Const WindowStyleHide = 0
Const WindowStyleNormal = 1
Const WindowStyleMaximize = 3
Const WindowStyleMinimize = 6
Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessId As Long
  dwThreadId As Long
End Type
Type STARTUPINFO
  cb As Long
  lpReserved As String
  lpDesktop As String
  lpTitle As String
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Byte
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type
Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
Const PriorityNormal = 32
Const PriorityLow = 64
Const PriorityHigh = 128
Const STARTF_USESHOWWINDOW = &H1
Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName _
   As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, _
   lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags _
   As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _
   lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

'Codemodul
Public Function ExecuteProgram(ByVal ProgramFile As String, ByVal WorkDir As String, ByVal _
    WaitTime As Long, ByVal WindowStyle As Long, ByVal Priority As Long) As Boolean
  Dim sInfo As STARTUPINFO
  Dim pInfo As PROCESS_INFORMATION
  Dim sAttr1 As SECURITY_ATTRIBUTES
  Dim sAttr2 As SECURITY_ATTRIBUTES
  sAttr1.nLength = Len(sAttr1)
  sAttr2.nLength = Len(sAttr2)
  sInfo.cb = Len(sInfo)
  sInfo.dwFlags = STARTF_USESHOWWINDOW
  sInfo.wShowWindow = WindowStyle
  If CreateProcess(vbNullString, ProgramFile, sAttr1, sAttr2, False, Priority, 0&, WorkDir, sInfo, pInfo) Then
    WaitForSingleObject pInfo.hProcess, WaitTime
    SuperShell = True
  Else
    SuperShell = False
  End If
End Function

'*** Aufruf ***
Sub TestCall()
  If ExecuteProgram("Notepad.exe", vbNullString, 500, WindowStyleNormal, PriorityHigh) = True Then
    MsgBox "Das Programm wurde gestartet."
  Else
    MsgBox "Das Programm konnte nicht gestartet werden."
  End If
End Sub

	Verwandte Codebeispiele
	Anwendung starten und Makroausführung anhalten Programm starten und warten, bis es beendet wurde Programm starten und warten, bis es beendet oder die Esc-Taste gedrückt wurde

Priorität eines laufenden Prozesses ändern

.Beschreibung
Noch keine Lösung gefunden!

.VBA-Code
Public Sub SetProcessPriority()

End Sub

Externer Zellbezug mit Datei- und Tabellenname erstellen

.Beschreibung
Beschreibung folgt.

Durch Setzen des External-Argumentes der Address-Eigenschaft auf True kann man die Zelladresse als einen externen Zellbezug erhalten.

.VBA-Code
Public Sub GetExternalLink()
  MsgBox Workbooks("EineMappe.xls").Worksheets("EineTabelle").Range("A1").Address(External:=True)
End Sub

Prüfen, ob eine Diskette genügend freien Speicherplatz besitzt

.Beschreibung
Bevor man eine Datei auf ein wechselbares Speichermedium (z.B. eine Diskette) kopiert, sollte man grundsätzlich zuerst überprüfen, ob der Ziel-Datenträger genügend freien Speicherplatz besitzt. Dazu muss man lediglich die Grösse der Datei mit dem verfügbaren Speicherplatz vergleichen. Wie das geht, zeigt das folgende Beispiel.

Laufzeitfehler 61 "Datenträger voll"

.VBA-Code
Public Sub CheckFreeFloppyDiskSpace()
  Dim lngFileSize As Long
  Dim lngDiskSpace As Long
  lngFileSize = FileLen("C:\Daten\EineMappe.xls")
  lngDiskSpace = CreateObject("Scripting.FileSystemObject").GetDrive("A:").FreeSpace
  If lngFileSize > lngDiskSpace Then
    MsgBox "Der Datenträger besitzt nicht genügend freien Speicherplatz." & vbCrLf & vbCrLf & _
      "Frei:" & Chr$(9) & Format$(lngDiskSpace, "#,##0") & " Bytes" & vbCrLf & _
      "Benötigt:" & Chr$(9) & Format$(lngFileSize, "#,##0") & " Bytes" & vbCrLf & _
      "Fehlend:" & Chr$(9) & Format$(lngFileSize - lngDiskSpace, "#,##0") & " Bytes", vbInformation
  End If
End Sub

	Verwandte Codebeispiele
	Gesamter Speicherplatz eines Laufwerkes abfragen Grösse eines Laufwerkes abfragen Freier Speicherplatz eines Laufwerkes abfragen Verfügbarer Speicherplatz eines Laufwerkes abfragen Belegter Speicherplatz eines Laufwerkes abfragen

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Prüfen, ob ein Laufwerk ein CD-ROM Laufwerk ist

.Beschreibung
Mit der DriveType-Eigenschaft des Drive-Objektes aus der FileSystemObject-Bibliothek kann man unter anderem herausfinden, ob ein Laufwerk ein CD-ROM Laufwerk ist.

.VBA-Code
Public Function IsCDROMDrive(ByVal strDriveLetter As String) As Boolean
  If CreateObject("Scripting.FileSystemObject").GetDrive(strDriveLetter).DriveType = 4 Then
    IsCDROMDrive = True
  Else
    IsCDROMDrive = False
  End If
End Function

'*** Aufruf ***
Sub TestCall()
  Dim strDrive As String
  strDrive = "E:"
  MsgBox "Das Laufwerk " & strDrive & " ist ein CD-ROM: " & IsCDRUMDrive(strDrive)
End Sub

	Verwandte Codebeispiele
	Typ eines Laufwerkes abfragen Prüfen, ob ein Laufwerk verfügbar und bereit ist

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Textdatei öffnen und sequentiell lesen

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub ReadTextfile()

End Sub

Installierte Schriften auflisten

.Beschreibung
Beschreibung folgt.

Erstellt eine Liste der in Microsoft Excel verfügbaren Schriften auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe.

.VBA-Code
Public Sub ListInstalledFonts()
  Dim intFonts As Integer
  Dim wksSheet As Worksheet
  Dim objFontControl As Object
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  Set objFontControl = Application.CommandBars("Formatting").FindControl(Id:=1728)
  For intFonts = 0 To objFontControl.ListCount - 1
    wksSheet.Cells(intFonts + 1, 1).Value = objFontControl.List(intFonts + 1)
  Next intFonts
  wksSheet.Cells(1, 1).EntireColumn.AutoFit
  Set objFontControl = Nothing
  Set wksSheet = Nothing
End Sub

	Verwandte Codebeispiele
	Schriftart installieren Schriftart deinstallieren Prüfen, ob eine Schriftart installiert ist

Arbeitsmappe basierend auf einer anderen Arbeitsmappe erstellen

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub AddWorkbook()
  Workbooks.Add "C:\Daten\EineMappe.xls"
End Sub

	Verwandte Codebeispiele
	Arbeitsmappe anlegen Arbeitsmappe mit einem Arbeitsblatt anlegen Arbeitsmappe mit mehreren Arbeitsblättern anlegen Arbeitsmappe mit einem Diagramm-, Makro- oder Dialogblatt anlegen Arbeitsmappe basierend auf einer Vorlage erstellen Arbeitsmappe anlegen und sofort speichern Arbeitsmappe anlegen und Mappenfenster sofort ausblenden

Arbeitsmappe basierend auf einer Vorlage erstellen

.Beschreibung
Dieses Codebeispiel legt eine neue Arbeitsmappe basierend auf der Mustervorlage "C:\Daten\VorlageMappe.xlt" an.

.VBA-Code
Public Sub AddWorkbook()
  Workbooks.Add "C:\Daten\VorlageMappe.xlt"
End Sub

Arbeitsmappe anlegen und sofort speichern

.Beschreibung
Dieses Codebeispiel legt eine neue Arbeitsmappe an und speichert diese unmittelbar danach.

.VBA-Code
Public Sub AddAndSaveWorkbook()
  Workbooks.Add.SaveAs "C:\Daten\EineMappe.xls"
End Sub

Arbeitsmappe anlegen und Mappenfenster sofort ausblenden

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub AddAndHideWorkbook()
  Workbooks.Add.Windows(1).Visible = False
End Sub

Arbeitsmappe mit einem Diagramm-, Makro- oder Dialogblatt anlegen

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub AddWorkbook()
  Workbooks.Add xlWBATChart
End Sub

Datei öffnen-Dialog anzeigen und ausgewählte Datei schreibgeschützt öffnen

.Beschreibung
Beschreibung folgt.

Durch Setzen von arg3 auf True wird die ausgewählte Datei schreibgeschützt geöffnet. Im Titel des Arbeitsmappenfensters erscheint der Hinweis "[Schreibgeschützt]".

.VBA-Code
Public Sub ShowOpenDialogAndOpenFileReadOnly()
  Application.Dialogs(xlDialogOpen).Show arg3:=True
End Sub

	Verwandte Codebeispiele
	Datei öffnen-Dialog anzeigen Datei öffnen-Dialog anzeigen und Pfad/Datei vorblenden Prüfen, ob die aktive Arbeitsmappe schreibgeschützt geöffnet wurde

Aktuelles Laufwerk wechseln

.Beschreibung
Beschreibung folgt.

Es wird bei ChDrive generell nur das erste Zeichen berücksichtigt. Erlaubt sind nur Buchstaben von A bis Z (Gross-/Kleinschreibung ist egal).

.VBA-Code #1
Public Sub ChangeCurrentDrive1()
  ChDrive "D"
End Sub

.VBA-Code #2
Public Sub ChangeCurrentDrive2()
  ChDrive "C:\Daten"
End Sub

.Hinweis
Bitte beachten Sie, dass ChDrive keine UNC-Pfade verarbeiten kann. Es können nur Laufwerksbuchstaben angegeben werden. Im Gegensatz zu ChDrive kann ChDir auch zwischen Verzeichnissen wechseln, die als UNC-Pfade angegeben werden.

	Verwandte Codebeispiele
	Aktuelles Verzeichnis wechseln Aktuelles Verzeichnis ermitteln

	Weitere Informationen
	VBA-Befehle und -Funktionen

Aktuelles Verzeichnis wechseln

.Beschreibung
Beschreibung folgt.

Wenn sich das gewünschte Verzeichnis nicht auf dem aktuellen Laufwerk befindet, muss zuerst das Laufwerk mit ChDrive gewechselt werden.

.VBA-Code
Public Sub ChangeCurrentDirectory()
  ChDir "C:\Backup"
End Sub

	Verwandte Codebeispiele
	Aktuelles Verzeichnis ermitteln Aktuelles Laufwerk wechseln

	Weitere Informationen
	VBA-Befehle und -Funktionen Kompatibilität zwischen Excel für Windows und Excel für Macintosh

Arbeitsmappe für die gemeinsame Bearbeitung freigeben

.Beschreibung
Beschreibung folgt.

Wenn Sie möchten, dass eine Arbeitsmappe von mehreren Benutzern gleichzeitig bearbeitet werden kann, so muss die Arbeitsmappe freigegeben werden. Dies wird erreicht, indem die Mappe mit der SaveAs-Methode gespeichert wird, wobei das Argument AccessMode mit xlShared angegeben wird.

Eine andere Variante ist die Verwendung der ProtectSharing-Methode. Sie gibt die Arbeitsmappe ebenfalls frei, wobei die Freigabe automatisch geschützt wird.

.VBA-Code #1
Public Sub ShareWorkbook1()
  ActiveWorkbook.SaveAs FileName:="C:\Daten\Freigegeben.xls", AccessMode:=xlShared
End Sub

.VBA-Code #2
Public Sub ShareWorkbook2()
  ActiveWorkbook.ProtectSharing FileName:="C:\Daten\Freigegeben.xls"
End Sub

Verwandte Codebeispiele

Freigabe einer Arbeitsmappe für die gemeinsame Bearbeitung aufheben Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigeben ist Prüfen, ob eine geschlossene Arbeitsmappe freigegeben ist Prüfen, ob eine freigegebene Arbeitsmappe gerade von einem anderen Benutzer bearbeitet wird Freigegebene Arbeitsmappe schützen Freigegebene Arbeitsmappe mit einem Freigabekennwort schützen Freigabeschutz einer freigegebenen Arbeitsmappe aufheben

Freigabe einer Arbeitsmappe für die gemeinsame Bearbeitung aufheben

.Beschreibung
Beschreibung folgt.

Wenn Sie SaveAs mit dem Argument "AccessMode:=xlExclusive" verwenden, so muss die Arbeitsmappe unter einem anderen Namen gespeichert werden. Das heisst, dass für "Filename" ein anderer Dateiname angegeben werden muss. Anderenfalls wird die Arbeitsmappe zwar (unter dem gleichen Namen) gespeichert, aber die Freigabe nicht aufgehoben. Eine Fehlermeldung erscheint nicht. Ausschnitt aus der Excel-VBA-Referenz: "Wenn Sie ein gemeinsam genutztes Dokument speichern, ohne den Dateinamen zu ändern, wird dieses Argument ignoriert. Verwenden Sie die ExclusiveAccess-Methode, um den Zugriffsmodus zu ändern."

ExclusiveAccess erzeugt einen Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler", wenn die Arbeitsmappe nicht freigegeben ist. Sie sollten daher zuerst überprüfen, ob die Mappe tatsächlich für die gemeinsame Bearbeitung freigegeben ist (siehe Codebeispiel #3).

Ist die Arbeitsmappe freigegeben aber die Freigabe geschützt (egal ob mit oder ohne Kennwort), so erscheint der Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler", weil wegen dem Schutz kein exklusiver Zugriff gewährt werden kann.

Nebenbei erwähnt gibt es die MultiUserEditing-Eigenschaft, welche bei einer freigegebenen Mappe True enthält. Es ist nicht möglich, diese Eigenschaft einfach auf False zu setzen, da sie schreibgeschützt ist.

.VBA-Code #1
Public Sub RemoveWorkbookSharing1()
  ActiveWorkbook.SaveAs FileName:="C:\Daten\NichtFreigegeben.xls", AccessMode:=xlExclusive
End Sub

.VBA-Code #2
Public Sub RemoveWorkbookSharing2()
  ActiveWorkbook.ExclusiveAccess
End Sub

.VBA-Code #3
Public Sub RemoveWorkbookSharing3()
  If ActiveWorkbook.MultiUserEditing Then
    ActiveWorkbook.ExclusiveAccess
  End If
End Sub

.Hinweis
Bitte beachten Sie folgendes ungewöhnliche Verhalten von Microsoft Excel:

Bei der ersten Ausführung von ExclusiveAccess erscheint der Laufzeitfehler 1004 "Diese Arbeitsmappe enthält VBA-Makros. Visual Basic-Module können im Freigabemodus nicht bearbeitet werden." Bei jeder weiteren Ausführung von ExclusiveAccess tritt der Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler" auf.

Verwandte Codebeispiele

Arbeitsmappe für die gemeinsame Bearbeitung freigeben Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigeben ist Prüfen, ob eine freigegebene Arbeitsmappe gerade von einem anderen Benutzer bearbeitet wird Freigegebene Arbeitsmappe schützen Freigegebene Arbeitsmappe mit einem Freigabekennwort schützen Freigabeschutz einer freigegebenen Arbeitsmappe aufheben Prüfen, ob eine geschlossene Arbeitsmappe freigegeben ist

Freigegebene Arbeitsmappe schützen

.Beschreibung
Ist die Arbeitsmappe freigegeben, so wird die Freigabe geschützt. Es wird kein Freigabeschutz-Kennwort zugewiesen.

Ist die Arbeitsmappe nicht freigegeben, so wird sie freigegeben und gleichzeitig die Freigabe geschützt. Da Arbeitsmappen beim Freigeben immer gespeichert werden, erscheint die Rückfrage "Eine Datei mit dem Namen <x> existiert schon an diesem Platz. Soll sie ersetzt werden?".

Ist die Freigabe bereits geschützt (egal ob mit oder ohne Freigabeschutz-Kennwort), so passiert nichts. Der bisherige Schutz bleibt bestehen.

.VBA-Code
Public Sub ProtectSharedWorkbook()
  ActiveWorkbook.ProtectSharing
End Sub

	Verwandte Codebeispiele
	Freigegebene Arbeitsmappe mit einem Freigabekennwort schützen Freigabeschutz einer freigegebenen Arbeitsmappe aufheben Prüfen, ob die Freigabe einer freigegebenen Arbeitsmappe geschützt ist Arbeitsmappe für die gemeinsame Bearbeitung freigeben Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigeben ist

Freigegebene Arbeitsmappe mit einem Freigabekennwort schützen

.Beschreibung
Es ist mit VBA tatsächlich nicht direkt möglich, eine freigegebene Arbeitsmappe mit einem Freigabekennwort zu schützen. Ist die Arbeitsmappe bereits freigegeben, so kann die Freigabe nicht durch ein Kennwort geschützt werden! Über die Benutzeroberfläche von Microsoft Excel ist es wohlgemerkt kein Problem, eine bereits freigegebene (ungeschützte) Mappe mit einem Freigabekennwort zu schützen.

Man kann die Freigabe einer freigegebenen Arbeitsmappe zwar schützen, jedoch nur ohne Kennwort. Wenn man ein Kennwort angibt, so wird die Mappe zwar geschützt, aber das angegebene Kennwort schlicht ignoriert! Das Schützen der Freigabe einer bereits freigegebenen Arbeitsmappe ist somit möglich, aber eben nur ohne Kennwort.

Wenn man jedoch ein Kennwort zuweisen möchte, so gibt es nur einen Lösungsweg: Die Freigabe der Arbeitsmappe muss zuerst aufgehoben werden, damit die Mappe anschliessend freigegeben werden kann, mit gleichzeitigem Schützen der Freigabe und mit Zuweisen eines Kennwortes. Diese drei Schritte sind erforderlich:
1. Allfälliger Freigabeschutz aufheben
2. Freigabe der Arbeitsmappe aufheben
3. Arbeitsmappe neu freigeben, Freigabe schützen und Kennwort zuweisen

Gross-/Kleinschreibung beim Kennwort beachten.

.VBA-Code
Public Sub ProtectSharedWorkbook()
  ActiveWorkbook.UnprotectSharing
  ActiveWorkbook.ExclusiveAccess
  ActiveWorkbook.ProtectSharing SharingPasswort:="Sommer"
End Sub

	Verwandte Codebeispiele
	Freigegebene Arbeitsmappe schützen Freigabeschutz einer freigegebenen Arbeitsmappe aufheben Prüfen, ob die Freigabe einer freigegebenen Arbeitsmappe geschützt ist Arbeitsmappe für die gemeinsame Bearbeitung freigeben Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigeben ist

Freigabeschutz einer freigegebenen Arbeitsmappe aufheben

.Beschreibung
Man kann die Freigabe einer freigegebenen Arbeitsmappe schützen, und zwar entweder ohne oder mit einem Kennwort. Da es mit den zur Verfügung stehenden Elementen des Excel-Objektmodells nicht möglich ist herauszufinden, ob ein Kennwort verwendet wird, sollte man die verschiedenen Auswirkungen kennen, die beim Aufheben des Freigabeschutzes auftreten können. Die folgende Tabelle zeigt diese Auswirkungen:

Zu Beachten sind insbesondere die beiden Auswirkungen beim Versuch, einen Kennwort-Schutz ohne oder mit falschem Kennwort aufzuheben (in der obigen Tabelle rot markiert). Ist die Freigabe ohne Kennwort geschützt und man gibt ein Kennwort an, so wird dieses ignoriert und der Freigabeschutz aufgehoben (gelb markiert).

Ist die Arbeitsmappe freigegeben und die Freigabe durch ein Kennwort geschützt, so erscheint der Eingabeaufforderungsdialog "Freigabeschutz aufheben" und verlangt das Freigabe-Kennwort. Diese Aufforderung kann übrigens nicht mit "Application.DisplayAlerts = False" unterdrückt werden.

Wird das Freigabeschutz-Kennwort angegeben, wird der Freigabeschutz aufgehoben.

Wird ein falsches Freigabeschutz-Kennwort angegeben, tritt der Laufzeitfehler 1004 "Das eingegebene Kennwort ist ungültig. [...]" auf.

.VBA-Code #1
Public Sub UnprotectSharedWorkbook1()
  ActiveWorkbook.UnprotectSharing
End Sub

.VBA-Code #2
Public Sub UnprotectSharedWorkbook2()
  ActiveWorkbook.UnprotectSharing SharingPassword:="Sommer"
End Sub

Tipp!
Es gibt einen Trick, wie man herausfinden kann, ob eine Freigabe geschützt ist. Mehr dazu siehe unter Prüfen, ob die Freigabe einer freigegebenen Arbeitsmappe geschützt ist.

	Verwandte Codebeispiele
	Freigegebene Arbeitsmappe schützen Freigegebene Arbeitsmappe mit einem Freigabekennwort schützen Prüfen, ob die Freigabe einer freigegebenen Arbeitsmappe geschützt ist Arbeitsmappe für die gemeinsame Bearbeitung freigeben Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigeben ist

Prüfen, ob die Freigabe einer freigegebenen Arbeitsmappe geschützt ist

.Beschreibung
Es ist nicht möglich, anhand den im Excel-Objektmodell zur Verfügung stehenden Elementen herauszufinden, ob eine Freigabe geschützt ist. Folglich ist es auch nicht möglich herauszufinden, ob ein Freigabeschutz ein Kennwort verwendet oder nicht.

Es gibt jedoch einen Trick, der zumindest eine 'Notlösung' darstellt: Da in Microsoft Excel je nach vorhandenem Freigabeschutz den Menübefehl unter Extras/Schutz automatisch entsprechend beschriftet, kann man anhand dieser Beschriftung feststellen, ob die Freigabe geschützt ist. Das dazu benötigte Symbolleisten-Steuerelement besitzt die ID 3059. Wenn es die Beschriftung "Freigegebene Arbeitsmappe schützen..." besitzt, ist kein Schutz vorhanden. Beim Text "Freigabeschutz aufheben..." ist die Freigabe geschützt.

Diese Lösung ist insofern eine Notlösung, weil sie nur mit der deutschsprachigen Excelversion funktioniert. Zudem muss der abgefragte Menübefehl vorhanden sein. Wenn er beispielsweise durch den Benutzer entfernt wurde, tritt ein Laufzeitfehler auf.

.VBA-Code
Public Sub CheckSharingProtection()
  If InStr(CommandBars.FindControl(Id:=3059).Caption, "aufheben") Then
    MsgBox "Freigabe ist geschützt.", vbInformation
  Else
    MsgBox "Freigabe ist nicht geschützt.", vbInformation
  End If
End Sub

Namen der geöffneten Arbeitsmappen mit allen Arbeitsblättern auflisten

.Beschreibung
Beschreibung folgt...

.VBA-Code
Public Sub ListOpenWorkbooksWithSheets()
  Dim wkbBook As Workbook
  Dim wksSheet As Worksheet
  Dim intRow As Integer
  For Each wkbBook In Workbooks
    For Each wksSheet In wkbBook.Worksheets
      intRow = intRow + 1
      ActiveSheet.Cells(intRow, 1).Value = wkbBook.Name
      ActiveSheet.Cells(intRow, 2).Value = wksSheet.Name
    Next wksSheet
  Next wkbBook
End Sub

Dateiname in der Makrozuweisung eines Steuerelementes abfragen

.Beschreibung
Beschreibung folgt.

Schaltflächen von Symbolleisten

Menübefehle von Symbolleisten

Schaltflächen auf dem Arbeitsblatt (Formular-Steuerelemente)

'D:\Programme\Microsoft Office\Office\XLSTART\PERSONL.XLS'!AufrufVonTeileMich

'D:\Programme\Microsoft Office\Office\XLSTART\PERSONL.XLS'!ActivateNextSheet

.VBA-Code
Public Sub GetOnActionFile()
  MsgBox Application.CommandBars("MeineSymbolleiste").Controls("Schrift vergrössern").OnAction
  MsgBox ActiveSheet.Shapes("Button 1").OnAction
End Sub

Dateinamenerweiterungen mit zugeordnetem Dateityp auflisten

.Beschreibung
In Windows ist ein Dateityp einer oder mehreren Dateinamenerweiterungen zugeordnet. Welche Dateinamenerweiterungen zu welchen Dateitypen gehören, ist in der Windows Registry abgelegt (Schlüssel HKEY_CLASSES_ROOT).

Das nachstehende Codebeispiel zeigt, wie man eine Liste der Dateinamenerweiterungen mit ihren Dateitypen erhält. Die Liste wird zuerst anhand des DOS-Befehls ASSOC generiert und in die Datei "Assoc.txt" geschrieben. Der Dateiname und Pfad dieser Datei kann individuell festgelegt werden (siehe Konstante DestFile). Anschliessend wird der Inhalt dieser Datei in ein neues Arbeitsblatt der aktiven Arbeitsmappe eingefüllt.

Informationen über ASSOC erhalten Sie, indem Sie im Konsolenfenster/DOS-Fenster von Windows (aufrufen mit CMD) den Befehl "ASSOC /?" eingeben.

.VBA-Code
Public Sub ListExtensionsWithType()
  Dim strItem As String
  Dim intCounter As Integer
  Dim wksSheet As Worksheet
  Const DestFile As String = "C:\Daten\Assoc.txt"
  CreateObject("WScript.Shell").Run "CMD /C ASSOC >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  Open DestFile For Input As #1
    Do While Not EOF(1)
      intCounter = intCounter + 1
      Input #1, strItem
      wksSheet.Cells(intCounter, 1).Value = strItem
    Loop
  Close #1
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set wksSheet = Nothing
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Neue Dateinamenerweiterung mit Dateitypzuordnung registrieren Zugeordneter Dateityp einer Dateinamenerweiterung ermitteln Dateitypen mit den definierten Öffnen-Befehlen auflisten Öffnen-Befehl eines Dateityps ändern

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Dateitypen mit den definierten Öffnen-Befehlen auflisten

.Beschreibung
Die meisten Dateitypen besitzen einen so genannten Öffnen-Befehl (engl. Open Command). Der Öffnen-Befehl legt fest, was beim Öffnen einer Datei eines bestimmten Dateityps passieren soll. Der Befehl ist in der Windows Registry im Zweig des jeweiligen Dateityps abgelegt.

Registry-Eintrag "HKEY_CLASSES_ROOT\<Dateityp>\Shell\open\command"

Das nachstehende Codebeispiel zeigt, wie man eine Liste der Dateitypen mit ihren Öffnen-Befehlen erhält. Die Liste wird zuerst anhand des DOS-Befehls FTYPE generiert und in die Datei "FType.txt" geschrieben. Der Dateiname und Pfad dieser Datei kann individuell festgelegt werden (siehe Konstante DestFile). Anschliessend wird der Inhalt dieser Datei in ein neues Arbeitsblatt der aktiven Arbeitsmappe eingefüllt.

Informationen über FTYPE erhalten Sie, indem Sie im Konsolenfenster/DOS-Fenster von Windows (aufrufen mit CMD) den Befehl "FTYPE /?" eingeben.

.VBA-Code
Public Sub ListOpenCommands()
  Dim strItem As String
  Dim intCounter As Integer
  Dim wksSheet As Worksheet
  Const DestFile As String = "C:\Daten\FType.txt"
  CreateObject("WScript.Shell").Run "CMD /C FTYPE >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  Open DestFile For Input As #1
    Do While Not EOF(1)
      intCounter = intCounter + 1
      Line Input #1, strItem
      wksSheet.Cells(intCounter, 1).Value = strItem
    Loop
  Close #1
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set wksSheet = Nothing
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Öffnen-Befehl eines Dateityps ändern Neue Dateinamenerweiterung mit Dateitypzuordnung registrieren Zugeordneter Dateityp einer Dateinamenerweiterung ermitteln Dateinamenerweiterungen mit zugeordnetem Dateityp auflisten

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Öffnen-Befehl eines Dateityps ermitteln

.Beschreibung
Für die meisten Dateitypen ist in Windows ein so genannter Öffnen-Befehl definiert. Der Öffnen-Befehl legt fest, was beim Öffnen einer Datei des besagten Dateityps passieren soll.

Gibt den Öffnen-Befehl des Dateityps "Microsoft Excel-Arbeitsmappe" (entspricht der ProgID "Excel.Sheet.8") aus.

Der von FTYPE angezeigte Öffnen-Befehl wird in die Datei "C:\Daten\FType.txt" geschrieben. Man kann hier auch einen beliebigen anderen Datei- bzw. Pfadnamen verwenden.

Welche sonstigen Dateitypen bzw. Öffnen-Befehle es auf Ihrem Computer gibt, können Sie durch Eingabe von FTYPE ohne eines bestimmten Dateityps herausfinden (siehe Codebeispiel Dateitypen mit den definierten Öffnen-Befehlen auflisten).

Informationen über FTYPE erhalten Sie, indem Sie im Konsolenfenster/DOS-Fenster von Windows (aufrufen mit CMD) den Befehl "FTYPE /?" eingeben.

.VBA-Code
Public Sub GetOpenCommand()
  Dim strCommand As String
  Const DestFile As String = "C:\Daten\FType.txt"
  Const FileType As String = "Excel.Sheet.8"
  CreateObject("WScript.Shell").Run "CMD /C FTYPE " & FileType & " >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Open DestFile For Input As #1
    Line Input #1, strCommand
  Close #1
  MsgBox "Öffnen-Befehl des Dateityps '" & FileType & "':" & vbCrLf & Mid$(strCommand, Len(FileType) + 2)
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Dateitypen mit den definierten Öffnen-Befehlen auflisten Neue Dateinamenerweiterung mit Dateitypzuordnung registrieren Zugeordneter Dateityp einer Dateinamenerweiterung ermitteln Dateinamenerweiterungen mit zugeordnetem Dateityp auflisten

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Öffnen-Befehl eines Dateityps ändern

.Beschreibung
Mit FTYPE kann man den Öffnen-Befehls eines Dateityps nicht nur abfragen sondern auch ändern.

Programmdatei.exe

"C:\Programme\MeinProgramm"

Dateityp bwdfile

"%1" bedeutet, dass beim Programmstart die aktuell markierte Datei geöffnet wird.

Informationen über FTYPE erhalten Sie, indem Sie im Konsolenfenster/DOS-Fenster von Windows (aufrufen mit CMD) den Befehl "FTYPE /?" eingeben.

.VBA-Code
Public Sub ModifyOpenCommand()
  Dim strFileType As String
  Dim strOpenCommand As String
  strFileType = "bwdfile"
  strOpenCommand = Chr$(34) & "C:\Programme\MeinProgramm\Programmdatei.exe" & Chr$(34) & " %1"
  CreateObject("WScript.Shell").Run "CMD /C FTYPE " & strFileType & "=" & strOpenCommand, 6, True
End Sub

	Verwandte Codebeispiele
	Dateitypen mit den definierten Öffnen-Befehlen auflisten Neue Dateinamenerweiterung mit Dateitypzuordnung registrieren Zugeordneter Dateityp einer Dateinamenerweiterung ermitteln Dateinamenerweiterungen mit zugeordnetem Dateityp auflisten

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Dateitypen eines bestimmten Programmes auflisten

.Beschreibung
Dieses Codebeispiel erstellt eine Liste der Dateitypen, die mit einem bestimmten Programm geöffnet werden. Zu jedem Dateityp ist der entsprechende Öffnen-Befehl angegeben. Die Liste wird anhand von FTYPE generiert und in der Datei FType.txt gespeichert. Der Dateiinhalt wird anschliessend eingelesen, bezüglich des gesuchten Programmes ausgewertet und in ein neues Arbeitsblatt der aktiven Arbeitsmappe eingetragen.

Die Konstante Program enthält den Namen der exe-Datei des Programmes. Im Beispiel wird "excel.exe" verwendet.

Informationen über FTYPE erhalten Sie, indem Sie im Konsolenfenster/DOS-Fenster von Windows (aufrufen mit CMD) den Befehl "FTYPE /?" eingeben.

.VBA-Code
Public Sub ListFiletypesOfProgram()
  Dim strItem As String
  Dim intCounter As Integer
  Dim wksSheet As Worksheet
  Const DestFile As String = "C:\Daten\FType.txt"
  Const Program As String = "excel.exe"
  CreateObject("WScript.Shell").Run "CMD /C FTYPE >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Range("A1").Value = "Dateityp"
    .Range("B1").Value = "Öffnen-Befehl"
    .Range("A1:B1").Font.Bold = True
  End With
  intCounter = 1
  Open DestFile For Input As #1
    Do While Not EOF(1)
      Line Input #1, strItem
      If InStr(LCase$(strItem), LCase$(Program)) > 0 Then
        intCounter = intCounter + 1
        wksSheet.Cells(intCounter, 1).Value = Left$(strItem, InStr(strItem, "=") - 1)
        wksSheet.Cells(intCounter, 2).Value = Mid$(strItem, InStr(strItem, "=") + 1)
      End If
    Loop
  Close #1
  wksSheet.Range("A1:B1").EntireColumn.AutoFit
  Set wksSheet = Nothing
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Dateitypen mit den definierten Öffnen-Befehlen auflisten Öffnen-Befehl eines Dateityps ändern Neue Dateinamenerweiterung mit Dateitypzuordnung registrieren Zugeordneter Dateityp einer Dateinamenerweiterung ermitteln Dateinamenerweiterungen mit zugeordnetem Dateityp auflisten

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Unterordner eines Ordners als Verzeichnisbaum auflisten/darstellen

.Beschreibung
Neues Arbeitsblatt in die aktive Arbeitsmappe.

Schriftart "Courier New"

True bei Run bedeutet, dass die nächste Programmzeile erst dann ausgeführt wird, wenn der mit Run gestartete Prozess (CMD) beendet ist.

Der Schalter "/C" bewirkt, dass nach Ausführen des DOS-Befehls TREE der CMD-Prozess beendet bzw. das CMD-Fenster geschlossen wird.

Der Schalter "/A" von TREE bewirkt, dass der ASCII- statt des erweiterten Zeichensatzes verwendet wird.

.VBA-Code
Public Sub ShowDirectoryTree()
  Dim strItem As String
  Dim intCounter As Integer
  Dim wksSheet As Worksheet
  Const BaseFolder As String = "C:\Daten"
  Const DestFile As String = "C:\Tree.txt"
  ChDrive Left$(BaseFolder, 1)
  ChDir BaseFolder
  CreateObject("WScript.Shell").Run "CMD /C TREE /A >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  Open DestFile For Input As #1
    Do While Not EOF(1)
      intCounter = intCounter + 1
      Input #1, strItem
      wksSheet.Cells(intCounter, 1).Value = strItem
    Loop
  Close #1
  wksSheet.Range("A1:A" & CStr(intCounter)).Font.Name = "Courier New"
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set wksSheet = Nothing
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Dateien eines Ordners und allen Unterordnern als Verzeichnisbaum auflisten/darstellen

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Dateien eines Ordners und allen Unterordnern als Verzeichnisbaum auflisten/darstellen

.Beschreibung
Neues Arbeitsblatt in die aktive Arbeitsmappe.

Schriftart "Courier New"

True bei Run bedeutet, dass die nächste Programmzeile erst dann ausgeführt wird, wenn der mit Run gestartete Prozess (CMD) beendet ist.

Der Schalter "/C" bewirkt, dass nach Ausführen des DOS-Befehls TREE der CMD-Prozess beendet bzw. das CMD-Fenster geschlossen wird.

Der Schalter "/A" von TREE bewirkt, dass der ASCII- statt des erweiterten Zeichensatzes verwendet wird.

Der Schalter "/F" von TREE bewirkt, dass der ASCII- statt des erweiterten Zeichensatzes verwendet wird.

.VBA-Code
Public Sub ShowDirectoryTreeWithFiles()
  Dim strItem As String
  Dim intCounter As Integer
  Dim wksSheet As Worksheet
  Const BaseFolder As String = "C:\Daten"
  Const DestFile As String = "C:\Tree.txt"
  ChDrive Left$(BaseFolder, 1)
  ChDir BaseFolder
  CreateObject("WScript.Shell").Run "CMD /C TREE /A /F >" & DestFile, 6, True
  If Dir(DestFile) = "" Then
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  Open DestFile For Input As #1
    Do While Not EOF(1)
      intCounter = intCounter + 1
      Input #1, strItem
      wksSheet.Cells(intCounter, 1).Value = strItem
    Loop
  Close #1
  wksSheet.Range("A1:A" & CStr(intCounter)).Font.Name = "Courier New"
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set wksSheet = Nothing
  Kill DestFile
End Sub

	Verwandte Codebeispiele
	Unterordner eines Ordners als Verzeichnisbaum auflisten/darstellen

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Datei-Verknüpfung im Favoriten-Ordner erstellen

.Beschreibung
Mit diesem Codebeispiel können Sie eine Verknüpfung mit einer beliebigen Datei Ihrem Favoriten-Ordner hinzufügen.

Der Pfad des Favoriten-Ordners wird anhand SpecialFolders ermittelt.

.VBA-Code
Public Sub CreateShortcutInFavorites()
  Dim strFavoritesFolder As String
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  strFavoritesFolder = objWSHShell.SpecialFolders("favorites")
  Set objWSHShortcut = objWSHShell.CreateShortcut(strFavoritesFolder & "\EineMappe.lnk")
  With objWSHShortcut
    .TargetPath = "C:\Daten\EineMappe.xls"
    .Description = "Verknüpfung mit Arbeitsmappe"
    .WorkingDirectory = "C:\Daten"
    .WindowStyle = 1     '1 = Normale Fenstergrösse
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

	Verwandte Codebeispiele
	Verknüpfung mit Arbeitsmappendatei zu Favoriten hinzufügen Zu Favoriten hinzufügen-Dialog anzeigen Dateien des Favoriten-Ordners auflisten Pfad eines Spezialordners ermitteln

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Datei-Verknüpfung zu einer Programmdatei im Autostart-Ordner erstellen

.Beschreibung
Dieses Codebeispiel zeigt, wie Sie eine Verknüpfung zu einer Programmdatei in der Programmgruppe "Autostart" erstellen können. Diese Programmgruppe enthält die Dateien des Ordners "Autostart", welcher im Verzeichnis "Startmenü/Programme" des Profil-Verzeichnisses des Benutzers befindet. Der Verzeichnispfad des Autostart-Ordners wird anhand SpecialFolders des Shell-Objektes aus der Windows Script Host-Bibliothek ermittelt, indem das Element mit der Bezeichnung "startup" abgefragt wird. Die Datei-Verknüpfung wird mit der CreateShortcut-Methode angelegt.

Im Beispiel wird im Autostart-Ordner eine Verknüpfung "Programm.lnk" angelegt, welche das Ziel "C:\Programme\EinProgramm\Programm.exe" und das Arbeitsverzeichnis "C:\Daten" besitzt.

.VBA-Code
Public Sub CreateShortcutInAutostart()
  Dim strAutostartFolder As String
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  strAutostartFolder = objWSHShell.SpecialFolders("startup")
  Set objWSHShortcut = objWSHShell.CreateShortcut(strAutostartFolder & "\Programm.lnk")
  With objWSHShortcut
    .TargetPath = "C:\Programme\EinProgramm\Programm.exe"
    .Description = "Verknüpfung mit Programm"
    .WorkingDirectory = "C:\Daten"
    .WindowStyle = 1     '1 = Normale Fenstergrösse
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

	Verwandte Codebeispiele
	Verknüpfung mit Arbeitsmappendatei zu Favoriten hinzufügen Datei-Verknüpfung im Favoriten-Ordner erstellen Pfad eines Spezialordners ermitteln

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Internet-Verknüpfung erstellen

.Beschreibung
Eine Internet-Verknüpfung ist eine spezielle Datei-Verknüpfung, bei der das Verknüpfungsziel eine URL-Adresse ist. Internet-Verknüpfungsdateien besitzen die Dateinamenerweiterung "url".

» Codebeispiel #1: In diesem Beispiel wird eine Internet-Verknüpfung "Webseite.url" im Verzeichnis "C:\Daten" erstellt. Als URL wird "http://www.xlam.com" verwendet. Beachten Sie bitte, dass bei der Verknüpfungserstellung automatisch ein Backslash-Zeichen (\) an die URL angehängt wird. Wenn die Adresse ohne "http://" angegeben wird (z.B. "www.xlam.com"), dann wird "http://" automatisch hinzugefügt.

» Codebeispiel #2: ftp

» Codebeispiel #3: file (lokale Datei)

» Codebeispiel #4: file (lokales Verzeichnis)

.VBA-Code #1
Public Sub CreateURLShortcut1()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\Webseite.url")
  With objWSHShortcut
    .TargetPath = "http://www.xlam.com"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.VBA-Code #2
Public Sub CreateURLShortcut2()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\FTP.url")
  With objWSHShortcut
    .TargetPath = "ftp://195.186.84.74/files/muster.htm"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.VBA-Code #3
Public Sub CreateURLShortcut3()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\FILE-Datei.url")
  With objWSHShortcut
    .TargetPath = "file:///C:/Daten/EineMappe.xls"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.VBA-Code #4
Public Sub CreateURLShortcut4()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\FILE-Ordner.url")
  With objWSHShortcut
    .TargetPath = "file:///C:/Daten/Backup"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.Hinweis
Der bei CreateShortcut angegebene Dateiname muss bei Internet-Verknüpfungen zwingend die Dateinamenerweiterung "url" besitzen. Wenn Sie die Erweiterung "lnk" verwenden, wird eine gewöhnliche Datei-Verknüpfung erstellt. Wird eine andere Erweiterung als "url" oder "lnk" verwendet, tritt der Laufzeitfehler -2147352567 "Der Pfadname der Verknüpfung muss in .lnk oder .url enden." auf.

	Verwandte Codebeispiele
	E-Mail-Verknüpfung erstellen

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

E-Mail-Verknüpfung erstellen

.Beschreibung
Eine E-Mail-Verknüpfung ist eine spezielle Internet-Verknüpfung, bei der die URL eine "mailto"-Adresse ist. E-Mail- bzw. Internet-Verknüpfungen besitzen immer die Dateinamenerweiterung "url".

» Codebeispiel #1: In diesem Beispiel wird eine Internet-Verknüpfung "Mail-Formular.url" im Verzeichnis "C:\Daten" erstellt. Als Ziel-URL wird die Mail-Adresse "philipp.von.wartburg@bluewin.ch" verwendet.

» Codebeispiel #2: Dieses Codebeispiel soll zeigen, wie man eine Internet-Verknüpfung mit einer Mail-Vorlage erstellen kann (beispielsweise für eine Support-Anfrage). Die Verknüpfungsdatei heisst "Support-Mail.url" und wird im Verzeichnis "C:\Daten" gespeichert. Als Ziel-URL wird bei diesem Beispiel eine längere Zeichenfolge verwendet, welche mehrere Informationen enthält, die im E-Mail-Formular vorgeblendet werden:
- Empfänger-Mail-Adresse "support@pc-help.com"
- Mail-Adressen zweier Kopie-Empfänger "itsupport@company.ch" und "management@company.ch"
- Mail-Adresse des Blindkopie-Empfängers, welche aus dem Login-Namen des angemeldeten Benutzers und "@company.ch" zusammengesetzt wird
- Betreff "Dringendes PC-Problem!"
- Mitteilungstext "Folgender Fehler ist aufgetreten:"

.VBA-Code #1
Public Sub CreateURLMailShortcut1()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\Mail-Formular.url")
  With objWSHShortcut
    .TargetPath = "mailto:philipp.von.wartburg@bluewin.ch"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.VBA-Code #2
Public Sub CreateURLMailShortcut1()
  Dim strUserName As String
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  strUserName = CreateObject("WScript.Network").UserName
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut("C:\Daten\Support-Mail.url")
  With objWSHShortcut
    .TargetPath = "mailto:support@pc-help.com?cc=itsupport@company.ch,management@company.ch&bcc=" & strUserName & _
        "@company.ch&subject=Dringendes PC-Problem!&body=Folgender Fehler ist aufgetreten:"
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

.Hinweis
Der bei CreateShortcut angegebene Dateiname muss bei Internet-Verknüpfungen zwingend die Dateinamenerweiterung "url" besitzen. Wenn Sie die Erweiterung "lnk" verwenden, wird eine gewöhnliche Datei-Verknüpfung erstellt. Wird eine andere Erweiterung als "url" oder "lnk" verwendet, tritt der Laufzeitfehler -2147352567 "Der Pfadname der Verknüpfung muss in .lnk oder .url enden." auf.

	Verwandte Codebeispiele
	Internet-Verknüpfung erstellen

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Symbol einer Symbolleisten-Schaltfläche als Grafikdatei speichern

.Beschreibung
Speichert das Symbol einer Symbolleisten-Schaltfläche oder eines Menüelementes als Grafikdatei.

bmp, gif, jpg, jpeg, png

.VBA-Code
Public Sub ExportCommandBarButtonIcon()

End Sub

Arbeitsmappe alle x Minuten speichern

.Beschreibung
Beschreibung folgt.

Arbeitsmappe, in welcher sich der Programmcode befindet, wird immer nach Ablauf einer Minute gespeichert.

Mit der Prozedur StopSaveWorkbook wird der Intervall gestoppt.

Bevor die Arbeitsmappe geschlossen wird, muss die Prozedur StopSaveWorkbook ausgeführt werden.

.VBA-Code
'Deklarationsbereich
Private datTimer As Date

'Codemodul
Public Sub SaveWorkbook()
  ThisWorkbook.Save
  datTimer = Now + TimeValue("00:01:00")
  Application.OnTime datTimer, "SaveWorkbook"
End Sub

Public Sub StopSaveWorkbook()
  On Error Resume Next
  Application.OnTime datTimer, "SaveWorkbook", , False
End Sub

Arbeitblatt als Textdatei speichern

.Autor
Philipp von Wartburg, www.xlam.info

.VBA-Code
Public Sub SaveWorksheetAsText()

End Sub

Arbeitsbereich speichern

.Beschreibung
Beschreibung folgt.

.VBA-Code #1
Public Sub SaveWorkgroup1()
  Application.SaveWorkspace "C:\Daten\EinArbeitsbereich.xlw"
End Sub

.VBA-Code #2
Public Sub SaveWorkgroup2()
  Application.Save "C:\Daten\EinArbeitsbereich.xlw"
End Sub

	Weitere Informationen
	Excel-Objektmodell: Eigenschaften des Application-Objektes

Zugriffsmodus einer geöffneten Datei abfragen

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub GetFileMode()
  Open "C:\Daten\EineDatei.txt" For Input As #1
    MsgBox "Zugriffsmodus: " & FileAttr(1)
  Close #1
End Sub

	Weitere Informationen
	VBA-Befehle und -Funktionen

Dateien eines Ordners auflisten

.Beschreibung
Dieses Codebeispiel erstellt eine Liste der Dateien eines bestimmten Ordners. Aufgelistet werden die Dateinamen auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe. Dateien, die sich in einem Unterordner des Ordners befinden, werden nicht aufgeführt.

.VBA-Code
Public Sub ListFiles()
  Const Path As String = "C:\Dateien"
  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
  If objFolder.Files.Count = 0 Then
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objFile In objFolder.Files
    intCounter = intCounter + 1
    wksSheet.Cells(intCounter, 1).Value = objFile.Name
  Next
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing
End Sub

	Verwandte Codebeispiele
	Aktuell bearbeitete Dateien eines Ordners auflisten

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Aktuell bearbeitete Dateien eines Ordners auflisten

.Beschreibung
Mit diesem Programmcode werden alle Dateien eines bestimmten Ordners aufgelistet, die momentan von einem (anderen) Benutzer oder Prozess geöffnet sind. Aufgelistet werden die Dateinamen auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe. Dateien, die sich in einem Unterordner des Ordners befinden, werden nicht berücksichtigt.

.VBA-Code
Public Sub ListLockedFiles()
  Const Path As String = "C:\Dateien"
  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
  If objFolder.Files.Count = 0 Then
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  On Error Resume Next
  For Each objFile In objFolder.Files
    Open objFile.Path For Input Lock Read As #1
    Close #1
    If Err.Number = 70 Then
      Err.Clear
      intCounter = intCounter + 1
      wksSheet.Cells(intCounter, 1).Value = objFile.Name
    End If
  Next
  wksSheet.Range("A1").EntireColumn.AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing
End Sub

	Verwandte Codebeispiele
	Dateien eines Ordners auflisten Dateien eines Ordners und allen Unterordnern auflisten Dateien eines gesamten Laufwerkes auflisten

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Dateien eines Ordners und allen Unterordnern auflisten

.Beschreibung
Dieses Beispiel listet alle Dateien auf, die sich in einem Ordner und den Unterordnern befinden. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt.

.VBA-Code
Public Sub ListFolderFiles()

End Sub

	Verwandte Codebeispiele
	Dateien eines Ordners auflisten Aktuell bearbeitete Dateien eines Ordners auflisten Dateien eines gesamten Laufwerkes auflisten

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Dateien eines gesamten Laufwerkes auflisten

.Beschreibung
Beschreibung folgt.

Listet die Dateien auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe auf.

Schriftgrösse 8 Pt wird angewendet.

Vier Spalten: Nummer, Datei, Ordner, Pfad

Die Konstante MaxFiles legt die Anzahl der aufzulistenden Dateien fest. Der Wert darf nicht grösser als 65'536 sein, weil ein Tabellenblatt maximal 65'536 Zeilen besitzt. Da auf der ersten Zeile die Spaltenüberschriften stehen, können maximal 65'535 Dateien aufgelistet werden.

Im Beispiel werden sämtliche Dateien des Laufwerkes "C:" aufgelistet (bzw. die ersten 65'535 gefundenen Dateien).

Mit der Prozedur ListFilesOfDrive wird die Liste erstellt.

.VBA-Code
'Deklarationsbereich
Private objFSO As Object
Private objFolder As Object
Private wksSheet As Worksheet
Private MaxFiles As Long = 65536

'Codemodul
Public Function FindFile(ByVal sFolder As String, ByVal sFile As String, nDirs As Long, nFiles As Long) As Long
  Dim objTFolder As Object
  Dim sFileName As String
  On Error GoTo ErrorHandler
  Set objFolder = objFSO.GetFolder(sFolder)
  sFileName = Dir(objFSO.BuildPath(objFolder.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
  nDirs = nDirs + 1
  While Len(sFileName) <> 0
    nFiles = nFiles + 1
    If nFiles < MaxFiles + 1 Then
      With wksSheet
        .Cells(nFiles + 1, 1).Value = nFiles
        .Cells(nFiles + 1, 2).Value = sFileName
        .Cells(nFiles + 1, 3).Value = objFolder.Path
        .Cells(nFiles + 1, 4).Value = objFSO.BuildPath(objFolder.Path, sFileName)
      End With
      sFileName = Dir()
    Else
      sFileName = ""
    End If
  Wend
  If objFolder.SubFolders.Count > 0 Then
    If nFiles < MaxFiles + 1 Then
      For Each objTFolder In objFolder.SubFolders
        FindFile = FindFile + FindFile(objTFolder.Path, sFile, nDirs, nFiles)
      Next
    End If
  End If
  Exit Function
ErrorHandler:
  sFileName = ""
  Resume Next
End Function

Sub ListFilesOfDrive()
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Cells.Font.Size = 8
    .Range("A1:D1").Value = Array("Nr.", "Datei", "Ordner", "Pfad")
    .Range("A1:D1").Font.Bold = True
  End With
  Application.ScreenUpdating = False
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  FindFile "C:\", "*.*", 0, 0
  wksSheet.Range("A1:D1").EntireColumn.AutoFit
  wksSheet.Range("A1").Sort Key1:=wksSheet.Range("C2"), Order1:=xlAscending, _
     Key2:=wksSheet.Range("B2"), Order2:=xlAscending, Header:=xlGuess
  Application.ScreenUpdating = True
  Set objFSO = Nothing
  Set wksSheet = Nothing
End Sub

	Weitere Informationen
	VBA-Spezialthema: FileSystemObject (FSO)

Prüfen, ob eine Arbeitsmappe ein Schreibschutzkennwort verwendet

.Beschreibung
Gibt WriteReserved Wahr (True) zurück, so besitzt die Arbeitsmappe ein Schreibschutzkennwort.

.VBA-Code
Public Sub HasWriteReservedPassword()
  MsgBox "Schreibschutzkennwort vorhanden: " & ActiveWorkbook.WriteReserved
End Sub

Benutzername der Schreibschutzkennwort-Zuweisung abfragen

.Beschreibung
Beschreibung folgt.

Wenn die Arbeitsmappe kein Schreibschutzkennwort besitzt, wird der Name des aktuellen Excel-Benutzers ausgegeben.

.VBA-Code
Public Sub GetWriteResPasswordUserName()
  MsgBox "Benutzername der Schreibschutzkennwort-Zuweisung: " & ActiveWorkbook.WriteReservedBy
End Sub

Prüfen, ob eine Arbeitsmappe die Schreibschutz-Empfehlung besitzt

.Beschreibung
Die ReadOnlyRecommended-Eigenschaft des Workbook-Objektes bestimmt, ob die Arbeitsmappe eine Schreibschutz-Empfehlung besitzt.

.VBA-Code
Public Sub CheckReadOnlyRecommended()
  MsgBox "Benutzername der Schreibschutzkennwort-Zuweisung: " & ActiveWorkbook.ReadOnlyRecommended
End Sub

Prüfen, ob eine Arbeitsmappe für die gemeinsame Bearbeitung freigegeben ist

.Beschreibung
Beschreibung folgt.

Wenn die MultiUserEditing-Eigenschaft Wahr (True) enthält, dann ist die Arbeitsmappe freigegeben.

Wenn die RevisionNumber-Eigenschaft eine Zahl grösser 0 enthält, dann ist die Arbeitsmappe freigegeben.

.VBA-Code #1
Public Sub CheckWorkbookSharing1()
  MsgBox "Arbeitsmappe freigegeben: " & ActiveWorkbook.MultiUserEditing
End Sub

.VBA-Code #2
Public Sub CheckWorkbookSharing2()
  If ActiveWorkbook.RevisionNumber > 0 Then
    MsgBox "Die Arbeitsmappe ist freigegeben."
  End If
End Sub

.Hinweis
Auch wenn die Abfrage von MultiUserEditing das Ergebnis Wahr (True) zurückgibt, muss dies nicht unbedingt bedeuten, dass Sie die freigegebene Arbeitsmappe tatsächlich bearbeiten (genauer gesagt speichern) können. Es kann nämlich sein, dass Sie nicht mehr mit der Arbeitsmappendatei verbunden sind (z.B. weil ein anderer Bearbeiter der Arbeitsmappe Sie aus der Liste der Bearbeiter entfernt hat). Es kann auch sein, dass die Arbeitsmappe inzwischen nicht mehr freigegeben ist (d.h. ein anderer Bearbeiter die Freigabe aufgehoben hat). Dies alles trifft auch auf die RevisionNumber-Eigenschaft zu.

	Verwandte Codebeispiele
	Arbeitsmappe für die gemeinsame Bearbeitung freigeben Prüfen, ob eine geschlossene Arbeitsmappe freigegeben ist

Prüfen, ob das Betriebssystem vom Typ Windows NT/Windows 2000/Windows XP ist

.Beschreibung
Mit einer kleinen Programmroutine kann man überprüfen, ob das Betriebssystem (Windows) des Computers die NT-Architektur besitzt. Mit anderen Worten wird ermittelt, ob Windows NT, Windows 2000 beziehungsweise Windows XP eingesetzt wird.

Bei den 32-Bit Windows-Versionen existieren zwei verschiedene Architekturen: Die Windows 95- und die Windows NT-Architektur. Die Windows 95-Architektur wird von Windows 95, Windows 98 und Windows ME verwendet. Die Windows NT-Architektur von Windows NT 4.0, Windows 2000 und Windows XP (und vermutlich auch Windows Server 2003). Die Kenntnis der vorhandenen Windows-Architektur ist immer dann wichtig, wenn vorwiegend systemnahe Aktionen durchgeführt werden sollen, zum Beispiel wenn man wissen möchte, ob das Betriebssystem grundsätzlich Benutzer-Berechtigung unterstützt, wenn man den Status einer Taste abfragen oder wenn man ein Tastatur-Ereignis auslösen möchte.

.VBA-Code
'Deklarationsbereich
Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
Const VER_PLATFORM_WIN32_NT As Long = 2
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

'Codemodul
Function IsOSTypeNT() As Boolean
  Dim OSVer As OSVERSIONINFO
  OSVer.dwOSVersionInfoSize = Len(OSVer)
  GetVersionEx OSVer
  IsOSTypeNT = (OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

'*** Aufruf ***
Sub TestCall()
  If IsOSTypeNT() Then
    MsgBox "Das Betriebssystem ist vom Typ Windows NT."
  Else
    MsgBox "Das Betriebssystem ist nicht vom Typ Windows NT."
  End If
End Sub

	Verwandte Codebeispiele
	Prüfen, ob das Betriebssystem Datei-/Verzeichnis-Berechtigungen unterstützt Prüfen, ob ein Laufwerk Datei-/Verzeichnis-Berechtigungen unterstützt

Datei-Grösse abfragen

.Beschreibung
Die Grösse einer Datei wird am einfachsten mit der FileLen-Funktion von VBA abgefragt.

Ermittelt die Grösse einer Datei in Bytes.

.VBA-Code #1
Public Sub GetFileSize1()
  MsgBox "Dateigrösse: " & FileLen("C:\Daten\EineMappe.xls")
End Sub

.VBA-Code #2
Public Sub GetFileSize2()
  MsgBox "Dateigrösse: " & Format$(FileLen("C:\Daten\EineMappe.xls"), "#,##0")
End Sub

	Verwandte Codebeispiele
	Datei-Grösse einer geöffneten Datei abfragen

	Weitere Informationen
	VBA-Befehle und -Funktionen

Datei-Grösse einer geöffneten Datei abfragen

.Beschreibung
Beschreibung folgt.

Ermittelt die Grösse einer Datei in Bytes.

Achtung: Das Abfragen von LOF() schreibt den Inhalt des Buffer in die Datei!

.VBA-Code #1
Public Sub GetFileSize1()
  Open "C:\Daten\EineDatei.txt" For Input As #1
    MsgBox "Dateigrösse: " & LOF(1)
  Close #1
End Sub

.VBA-Code #2
Public Sub GetFileSize2()
  Open "C:\Daten\EineDatei.txt" For Append As #1
    MsgBox "Dateigrösse: " & LOF(1)
    Print #1, "0123456789"
    MsgBox "Dateigrösse: " & LOF(1)
  Close #1
End Sub

	Verwandte Codebeispiele
	Datei-Grösse abfragen

	Weitere Informationen
	VBA-Befehle und -Funktionen

Daten in eine Datei schreiben ohne die Datei zu schliessen

.Beschreibung
...

Trick: LOF() abfragen.

.VBA-Code
Public Sub WriteToFile()

End Sub

	Weitere Informationen
	VBA-Befehle und -Funktionen

Prüfen, ob eine freigegebene Arbeitsmappe gerade von einem anderen Benutzer bearbeitet wird

.Beschreibung
Beschreibung folgt.

Geht nur bei Arbeitsmappen, die für die gemeinsame Bearbeitung freigegeben sind.

.VBA-Code
Public Sub CheckOtherUserEditing()
  If UBound(ActiveWorkbook.UserStatus) > 1 Then
    MsgBox "Die Arbeitsmappe wird zur Zeit noch von einem anderen Benutzer bearbeitet."
  End If
End Sub

Laufende Windows-Tasks auflisten

.Beschreibung
Mit dieser Prozedur werden die Namen aller momentan ausgeführten Tasks im Direktfenster des VBA-Editors aufgelistet. Die Liste enthält sämtliche Tasks, also auch solche, die Sie als Benutzer nicht sehen (und kennen), wie beispielsweise "OleMainThreadWndName", "OLEChannelWnd" oder "DDE Server Window". Wenn Sie nur die Tasks möchten, die eine laufende Anwendung darstellen, müssen Sie die Visible-Eigenschaft des Tasks abfragen (siehe Codebeispiel Sichtbare Anwendungstasks auflisten).

.VBA-Code
Public Sub ListTasks()
  Dim intCounter As Integer
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  For intCounter = 1 To objWord.Tasks.Count
    Debug.Print intCounter & ": " & objWord.Tasks(intCounter).Name
  Next intCounter
  objWord.Quit
  Set objWord = Nothing
End Sub

	Verwandte Codebeispiele
	Sichtbare Anwendungstasks auflisten

Sichtbare Anwendungstasks auflisten

.Beschreibung
Dieses Beispiel zeigt, wie die Namen derjenigen momentan ausgeführten Tasks herausgefunden werden können, welche für eine Anwendung stehen. Die Namen werden im Direktfenster des VBA-Editors aufgelistet. Wenn man die Abfrage von "If objWord.Tasks(intCounter).Visible = True" weglässt, erhält man alle laufenden Windows-Tasks.

.VBA-Code
Public Sub ListVisibleTasks()
  Dim intCounter As Integer
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  For intCounter = 1 To objWord.Tasks.Count
    If objWord.Tasks(intCounter).Visible = True Then
      Debug.Print intCounter & ": " & objWord.Tasks(intCounter).Name
    End If
  Next intCounter
  objWord.Quit
  Set objWord = Nothing
End Sub

	Verwandte Codebeispiele
	Laufende Windows-Tasks auflisten

Laufende Microsoft Excel-Anwendungen auflisten

.Beschreibung
...

.VBA-Code
'Deklarationsbereich
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName _
   As String, ByVal lpWindowName As String) As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, _
   ByVal wFlag As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
   ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const GW_HWNDNEXT = 2

'Codemodul
Public Sub ListExcelTasks()
  Dim hWnd As Long
  Dim lRet As Long
  Dim sClassBuffer As String
  hWnd = FindWindow("XLMAIN", vbNullString)
  If hWnd <> 0 Then
    Debug.Print hWnd
    Do
      hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
      If hWnd = 0 Then
        Exit Do
      End If
      sClassBuffer = String(255, 0)
      lRet = GetClassName(hWnd, sClassBuffer, Len(sClassBuffer))
      sClassBuffer = Left(sClassBuffer, InStr(1, sClassBuffer, Chr(0), vbTextCompare) - 1)
      If UCase(sClassBuffer) = "XLMAIN" Then
        Debug.Print hWnd
      End If
    Loop
  End If
End Sub

	Verwandte Codebeispiele
	Laufende Windows-Tasks auflisten Sichtbare Anwendungstasks auflisten Laufende Instanzen einer anderen Anwendung auflisten

Prüfen, ob ein Windows-Task ausgeführt wird

.Beschreibung
Wenn Sie herausfinden möchten, ob ein bestimmter Task gerade ausgeführt wird, können Sie die Exists-Methode der Tasks-Auflistung aus der Microsoft Word-Objektbibliothek zu Hilfe nehmen.

Bitte beachten Sie, dass ein Mustervergleich vorgenommen wird. Wenn ein Task gefunden wird, dessen Name mit der bei Exists angegebenen Bezeichnung beginnt oder vollständig übereinstimmt, wird Wahr (True) zurückgegeben. Für das nachstehende Beispiel bedeutet dies, dass auch dann die Meldung "Microsoft Excel wird ausgeführt." ausgegeben wird, wenn die Anwendung Excel nicht läuft, aber die Hilfe/Referenz von Excel geöffnet ist, weil deren Fenster ebenfalls mit der Zeichenfolge "Microsoft Excel" beginnt.

.VBA-Code
Public Sub CheckIfTaskExists()
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  If objWord.Tasks.Exists("Microsoft Excel") = True Then
    MsgBox "Microsoft Excel wird ausgeführt."
  End If
  objWord.Quit
  Set objWord = Nothing
End Sub

	Verwandte Codebeispiele
	Laufende Windows-Tasks auflisten Sichtbare Anwendungstasks auflisten Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

.Beschreibung
Mit der API-Funktion FindWindow kann man den Fenster-Handle (Window Handle; Hwnd) eines beliebigen Fensters herausfinden. Häufig wird der Handle des Fensters einer laufenden Windows-Anwendung benötigt, damit man dem Fenster eine Nachricht schicken kann (z.B. Fenster schliessen oder Fenstergrösse ändern). Auch wenn man beispielsweise einen Windows-Dialog anzeigen möchte, muss man oft den Handle des so genannten Parent Window angeben.

Es kann auch der Fenster-Handle eines VBA-Benutzerformulares ermittelt werden.

Bitte beachten Sie, dass bei FindWindow der exakte Fenstername angegeben werden muss.

Wenn es mehrere Fenster gibt, die den gleichen Fensternamen besitzen, so wird gewöhnlich der Fenster-Handle desjenigen Fensters zurückgegeben, dessen Anwendung zuletzt gestartet wurde.

Im folgenden Beispiel wird der Fenster-Handle des Windows-Taschenrechners abgefragt.

.VBA-Code
'Deklarationsbereich
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

'Codemodul
Public Sub GetWindowHandle()
  Dim lngHwnd As Long
  lngHwnd = FindWindow(vbNullString, "Rechner")
  If lngHwnd <> 0 Then
    MsgBox "Fenster-Handle von Rechner: " & lngHwnd
  End If
End Sub

Tipp!
Mit dem Utility "Windows-Analyzer" erhalten Sie komfortabel jegliche Window Handles und Class Names beliebiger Fenster und Objekte. Das Tool ist Freeware und kann auf der Downloadseite heruntergeladen werden.

.Hinweis
Den Fenster-Handle des VBA-Editors erhalten Sie auch ohne die FindWindow-API-Funktion, nämlich ganz einfach mit
  MsgBox Application.VBE.MainWindow.hWnd

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) eines Fensters anhand ClassName ermitteln Fenster-Handle (hwnd) der aktuellen Excel-Sitzung ermitteln Fenster-Handle (hwnd) des aktiven Fensters ermitteln Fenster-Handle (hwnd) des Windows Desktop ermitteln

Fenster-Handle (hwnd) des aktiven Fensters ermitteln

.Beschreibung
...

.VBA-Code
'Deklarationsbereich
Declare Function GetForegroundWindow Lib "user32.dll" () As Long

'Codemodul
Public Sub GetActiveWindowHandle()
  MsgBox "Fenster-Handle: " & GetForegroundWindow
End Sub

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) der aktuellen Excel-Sitzung ermitteln Fenster-Handle (hwnd) des Windows Desktop ermitteln Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

Fenster-Handle (hwnd) des Windows Desktop ermitteln

.Beschreibung
...

ClassName "progman" oder WindowName "program manager"

.VBA-Code #1
'Deklarationsbereich
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal _
   lpClassName As String, ByVal lpWindowName As String) As Long

'Codemodul
Public Sub GetDesktopHandle1()
  MsgBox FindWindow("progman", vbNullString)
End Sub

.VBA-Code #2
'Deklarationsbereich
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal _
   lpClassName As String, ByVal lpWindowName As String) As Long

'Codemodul
Public Sub GetDesktopHandle2()
  MsgBox FindWindow(vbNullString, "program manager")
End Sub

.VBA-Code #3
'Deklarationsbereich
Declare Function GetDesktopWindow Lib "user32.dll" () As Long

'Codemodul
Public Sub GetDesktopHandle3()
  MsgBox GetDesktopWindow()
End Sub

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) des aktiven Fensters ermitteln Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

Fenster-Handle (hwnd) des VBA-Editors ermitteln

.Beschreibung
...

.VBA-Code
Public Sub GetVBEWindowHandle()
  MsgBox Application.VBE.MainWindow.hWnd
End Sub

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) des aktiven Fensters ermitteln Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

Fenster-Handle (hwnd) eines Benutzerformulares ermitteln

.Beschreibung
...

.VBA-Code
Public Sub GetUserFormWindowHandle()

End Sub

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) des aktiven Fensters ermitteln Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

Fenster-Handle (hwnd) der aktuellen Excel-Sitzung ermitteln

.Beschreibung
...

.VBA-Code
'Deklarationsbereich
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal _
   lpClassName As String, ByVal lpWindowName As String) As Long

Public Sub GetExcelWindowHandle()
  MsgBox FindWindow("xlmain", Application.Caption)
End Sub

	Verwandte Codebeispiele
	Fenster-Handle (hwnd) des aktiven Fensters ermitteln Fenster-Handle (hwnd) einer laufenden Anwendung ermitteln

ClassName zu einem Fenster-Handle (hwnd) ermitteln

.Beschreibung
...

Man hat den Fenstertitel oder den Fenster-Handle und möchte nun herausfinden, zu welcher Anwendung das Fenster gehört.

.VBA-Code
Public Sub GetClassName()
Dim hWnd As Long
Dim lRet As Long
Dim sClass As String
hWnd = FindWindow(vbNullString, "Rechner")
If hWnd <> 0 Then
sClass = String(255, 0)
lRet = GetClassName(hWnd, sClass, Len(sClass))
sClass = Left(sClass, InStr(1, sClass, Chr(0), vbTextCompare) - 1)
Debug.Print hWnd, sClass
End If
End Sub

Fenster einer anderen Anwendung verschieben

.Beschreibung
Die einfachste Variante, das Fenster einer anderen Anwendung zu verschieben, stellt die Move-Methode des Task-Objektes aus der Microsoft Word Objektbibliothek dar. Microsoft Excel bietet kein derartiges Objekt bzw. keine derartige Methode. Das Gute an dieser Lösung ist, dass nicht einmal der genaue Name des Anwendungtasks bekannt sein muss. Es genügt, den Anfang des Fenstertitels anzugeben.

» Das Codebeispiel #1 muss unter Microsoft Word ausgeführt werden (d.h. in einem VBA-Projekt eines Word-Dokumentes).

» Das Beispiel #2 zeigt die Lösung mittels Automation. Dieser Code kann in einem beliebigen Office-Programm oder auch in einem Visual Basic-Programm ausgeführt werden.

.VBA-Code #1
Public Sub MoveWindow1()
  Application.Tasks("Rechner").Move 50, 100    'Links, Oben
End Sub

.VBA-Code #2
Public Sub MoveWindow2()
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  objWord.Tasks("Rechner").Move 50, 100    'Links, Oben
  objWord.Quit
  Set objWord = Nothing
End Sub

Fenster einer anderen Anwendung ausblenden

.Beschreibung
Anhand der Visible-Eigenschaft des Task-Objektes aus der Microsoft Word-Objektbibliothek kann man ein beliebiges Anwendungsfenster ausblenden - und natürlich auch wieder einblenden. Der genaue Name des Anwendungtasks muss nicht bekannt sein. Es genügt, den Anfang des Fenstertitels anzugeben.

Das Einblenden eines sichtbaren Fensters bzw. das Ausblenden eines ausgeblendeten Fensters erzeugt keine Fehlermeldung.

» Das Codebeispiel #1 muss unter Microsoft Word ausgeführt werden (d.h. in einem VBA-Projekt eines Word-Dokumentes).

» Das Beispiel #2 zeigt die Lösung mittels Automation. Dieser Code kann in einem beliebigen Office-Programm oder auch in einem Visual Basic-Programm ausgeführt werden.

» Codebeispiel #3: Anwendungsfenster einblenden (in einem Word VBA-Projekt).

» Codebeispiel #4: Anwendungsfenster einblenden.

.VBA-Code #1
Public Sub HideWindow1()
  Application.Tasks("Rechner").Visible = False
End Sub

.VBA-Code #2
Public Sub HideWindow2()
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  objWord.Tasks("Rechner").Visible = False
  objWord.Quit
  Set objWord = Nothing
End Sub

.VBA-Code #3
Public Sub ShowWindow3()
  Application.Tasks("Rechner").Visible = True
End Sub

.VBA-Code #4
Public Sub ShowWindow4()
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  objWord.Tasks("Rechner").Visible = True
  objWord.Quit
  Set objWord = Nothing
End Sub

Alle Anwendungsfenster minimieren

.Beschreibung
Mit diesem Programmcode werden die Fenster der laufenden Anwendungen minimiert.

.VBA-Code
Public Sub MinimizeWindows()
  Dim intCounter As Integer
  Dim objWord As Object
  Set objWord = CreateObject("Word.Application")
  For intCounter = 1 To objWord.Tasks.Count
    If objWord.Tasks(intCounter).Visible = True Then
      objWord.Tasks(intCounter).WindowState = 2
    End If
  Next intCounter
  objWord.Quit
  Set objWord = Nothing
End Sub

Fenster einer laufenden Anwendung aktivieren

.Beschreibung
...

scicalc ist der ClassName des Windows Taschenrechners.

.VBA-Code
'Deklarationsbereich
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
   lpClassName As String, ByVal lpWindowName As String) As Long

'Codemodul
Public Sub ActivateWindow()
  SetForegroundWindow FindWindow("scicalc", vbNullString)
End Sub

Mehrere Textdateien zu einer Datei zusammenführen

.Beschreibung
Wenn Sie die Inhalte von mehreren Textdateien in einer einzigen Datei zusammenfassen möchten, so benutzen Sie am besten den alten COPY-Befehl von MS DOS. Dieser erlaubt die Verwendung des Plus-Zeichens (+) zum Angeben mehrerer Quelldateien.

Bitte beachten Sie folgende Punkte:
- Die Dateiinhalte werden in der Reihenfolge der Quelldateien zusammengeführt.
- Der Schalter "/B" muss vor jeder Quelldatei stehen, damit das binäre Kopierverfahren verwendet wird.
- Die Quelldateien dürfen nicht versteckt sein. Ist eine Quelldatei versteckt, wird sie einfach übergangen. Es tritt keine Fehlermeldung auf.
- Eine vorhandene, gleichnamige Zieldatei wird automatisch überschrieben.

» Codebeispiel #1: Bevor Shell ausgeführt wird, wird mittels ChDrive und ChDir zu demjenigen Verzeichnis gewechselt, in welchem sich die Dateien befinden (im Beispiel "C:\Daten").

» Codebeispiel #2: Die drei Quelldateien werden anhand von relativen Pfadangaben bestimmt. Die Zieldatei befindet sich im Ordner "D:\Neu".

.VBA-Code #1
Public Sub CopyFilesTogether1()
  ChDrive "C:\Daten"
  ChDir "C:\Daten"
  Shell "CMD /C COPY /B Quelldatei1.txt /B +Quelldatei2.txt Zieldatei.txt", vbMinimizedNoFocus
End Sub

.VBA-Code #2
Public Sub CopyFilesTogether2()
  Shell "CMD /C COPY /B ..\Quelldatei1.txt /B +Backup\Quelldatei2.txt /B +Quelldatei3.txt D:\Neu\Zieldatei.txt", vbMinimizedNoFocus
End Sub

.Hinweis
Die Syntax des COPY-Befehls erfahren Sie, wenn Sie im Konsolenfenster "COPY /?" eingeben. Das Konsolenfenster wird mit "CMD" geöffnet.

Prüfen, ob die in einem Hyperlink angegebene Datei existiert

.Beschreibung
Beschreibung folgt.

Der Hyperlink der aktiven Zelle wird überprüft.

UNC-Pfade werden nicht überprüft, ebenso auch keine Internet-Adressen (URLs wie http:, ftp:, file:, mailto: etc.).

Es werden absolute und relative Pfadangaben verarbeitet.

Die Hyperlink-Basis der Arbeitsmappe wird berücksichtigt.

Bei einem relativen Pfad wird der entsprechende absolute Pfad ausgegeben.

.VBA-Code
Public Sub CheckFileInHyperlink()
  Dim strPath As String
  ChDrive Left$(ActiveWorkbook.Path, 1)
  ChDir ActiveWorkbook.Path
  strPath = ActiveWorkbook.BuiltinDocumentProperties("Hyperlink base").Value
  If strPath <> "" Then
    If Dir(strPath, vbDirectory) = "" Then
      MsgBox "Das als Hyperlink-Basis eingetragene Verzeichnis existiert nicht.", vbInformation
      Exit Sub
    End If
  Else
    strPath = CurDir
  End If
  If ActiveCell.Hyperlinks.Count > 0 Then
    With ActiveCell.Hyperlinks(1)
      If Mid$(.Address, 2, 2) = ":\" Then
        If Dir(.Address, vbHidden) <> "" Then
          MsgBox "Datei in Hyperlink existiert (absoluter Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Datei: " & Chr$(9) & Dir(.Address, vbHidden) & vbCrLf & "Pfad: " & Chr$(9) & .Address, vbInformation
        Else
          MsgBox "Datei in Hyperlink existiert nicht (absoluter Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Pfad: " & Chr$(9) & .Address, vbInformation
        End If
      ElseIf Left$(.Address, 3) = "..\" Then
        If Dir(.Address, vbHidden) <> "" Then
          MsgBox "Datei in Hyperlink existiert (relativer Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Datei: " & Chr$(9) & Dir(.Address, vbHidden) & vbCrLf & "Pfad: " & Chr$(9) & CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(strPath & "\" & .Address), vbInformation
        Else
          MsgBox "Datei in Hyperlink existiert nicht (relativer Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Pfad: " & Chr$(9) & CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(strPath & "\" & .Address), vbInformation
        End If
      ElseIf .SubAddress = "" Then
        If Dir(strPath & "\" & .Address, vbHidden) <> "" Then
          MsgBox "Datei in Hyperlink existiert (relativer Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Datei: " & Chr$(9) & Dir(.Address, vbHidden) & vbCrLf & "Pfad: " & Chr$(9) & strPath & "\" & .Address, vbInformation
        Else
          MsgBox "Datei in Hyperlink existiert nicht (relativer Pfad)." & vbCrLf & vbCrLf & "Link: " & Chr$(9) & .Name & vbCrLf & "Pfad: " & Chr$(9) & strPath & "\" & .Address, vbInformation
        End If
      Else
        MsgBox "Der Hyperlink '" & .Name & "' enthält keine Dateiangabe oder einen UNC-Pfad.", vbInformation
      End If
    End With
  Else
    MsgBox "Die markierte Zelle enthält keinen Hyperlink.", vbInformation
  End If
End Sub

Dateien in Hyperlinks auflisten und ihre Existenz prüfen

.Beschreibung
Beschreibung folgt.

Hyperlinks der gesamten Arbeitsmappe werden überprüft.

URLs werden nicht berücksichtigt (Adressen wie HTTP, FTP, FILE, MAILTO etc.)

UNC-Pfade werden nicht berücksichtigt

.VBA-Code
Public Sub ListAndCheckFilesInHyperlinks()
  Dim objLink As Hyperlink
  Dim wksSheet As Worksheet
  Dim wkbWorkbook As Workbook
  Dim wksWorksheet As Worksheet
  Dim lngLinks As Long
  ChDrive Left$(ThisWorkbook.Path, 1)
  ChDir ThisWorkbook.Path
  Set wkbWorkbook = Application.Workbooks.Add(Template:=xlWBATWorksheet)
  Set wksWorksheet = wkbWorkbook.Worksheets(1)
  With wksWorksheet
    .Range("A1").Value = "Hyperlink"
    .Range("B1").Value = "Datei"
    .Range("C1").Value = "Vorhanden"
    .Range("A1:C1").Font.Bold = True
  End With
  For Each wksSheet In ThisWorkbook.Worksheets
    For Each objLink In wksSheet.Hyperlinks
      If Left$(objLink.Address, 3) = "..\" Or Mid$(objLink.Address, 2, 2) = ":\" Or objLink.SubAddress = "" Then
        lngLinks = lngLinks + 1
        With wksWorksheet
          .Cells(lngLinks + 1, 1).Value = objLink.Name
          .Cells(lngLinks + 1, 2).Value = objLink.Address
          If Dir(objLink.Address, vbHidden) = "" Then
            .Cells(lngLinks + 1, 3).Value = "Ja"
          Else
            .Cells(lngLinks + 1, 3).Value = "Nein"
          End If
        End With
      End If
    Next
  Next
  wksWorksheet.Columns("A:C").AutoFit
  Set wksWorksheet = Nothing
  Set wkbWorkbook = Nothing
End Sub

Prüfen, ob der Hyperlink einer Zelle einen absoluten oder relativen Pfad verwendet

.Beschreibung
Beschreibung folgt.

Hyperlinks, die einen UNC-Pfad verwenden, können nicht überprüft werden.

.VBA-Code
Public Sub CheckHyperlinkPath()

End Sub

Datei in Hyperlink als Verknüpfung zu Favoriten hinzufügen

.Beschreibung
Beschreibung folgt.

Es ist ganz einfach, den in einer Arbeitsblattzelle stehenden Hyperlink als Verknüpfung zu den Favoriten hinzuzufügen.

Der Nachteil ist, dass die neue Verknüpfung im Basis-Ordner der Favoriten angelegt wird. Es ist nicht möglich, die Verknüpfung in einem Unterordner des Favoriten-Ordners zu erstellen.

Internetverknüpfung (Dateinamenerweiterung "url")

Hyperlink mit Exceldatei: Als Linkname wird nur der Dateiname verwendet, auch wenn der Hyperlink einen Dateipfad enthält. Der Link wird mit der Zieladresse "file:///" gefolgt vom vollständigen Dateinamen (Laufwerk/Verzeichnisse/Datei) aufgenommen. Das Symbol ist dasjenige einer Exceldatei.

Hyperlink mit URL: Als Linkname wird der gesamte Hyperlinkname verwendet, wobei er automatisch in runde Klammern eingefasst wird. Die Zieladresse entspricht dem Hyperlinknamen. Das Symbol ist dasjenige einer Webseite.

Wenn in den Favoriten bereits ein gleichnamiger Link vorhanden ist, so wird dieser automatisch überschrieben - auch wenn die Zieladresse unterschiedlich ist.

.VBA-Code
Public Sub AddHyperlinkToFavorites()
  ActiveCell.Hyperlinks(1).AddToFavorites
End Sub

	Verwandte Codebeispiele
	Verknüpfung mit Arbeitsmappendatei zu Favoriten hinzufügen Datei-Verknüpfung im Favoriten-Ordner erstellen

Verknüpfung mit einer Arbeitsmappe zur Links-Symbolleiste des Internet Explorers hinzufügen

.Beschreibung
Beschreibung folgt.

Die Steuerelement-ID 1022 repräsentiert der Menübefehl "Zu Favoriten hinzufügen" der Symbolleiste "Web", über den der "Zu Favoriten hinzufügen"-Dialog geöffnet wird.

Es wird die gerade aktive Arbeitsmappe verwendet.

Da der "Links"-Ordner auch einen anderen, frei wählbaren Namen besitzen darf, muss der Ordnername aus der Windows Registry geholt. Er ist im Eintrag "LinksFolderName" des Schlüssels "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Toolbar\LinksFolderName" abgelegt.

.VBA-Code
Public Sub AddWorkbookToLinksToolbar()
  Dim strLinksFolder As String
  Dim strFavoritesFolder As String
  Dim objWSHShell As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  strFavoritesFolder = objWSHShell.SpecialFolders("favorites")
  strLinksFolder = objWSHShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Toolbar\LinksFolderName")
  Set objWSHShell = Nothing
  If strLinksFolder = "" Then
    strLinksFolder = "Links"
  End If
  If Dir(strFavoritesFolder & "\" & strLinksFolder, vbDirectory) <> "" Then
    If Dir(strFavoritesFolder & "\" & strLinksFolder & "\" & ActiveWorkbook.Name & ".url") = "" Then
      SendKeys strLinksFolder & "\" & ActiveWorkbook.Name & ".url{enter}"
      Application.CommandBars.FindControl(Id:=1022).Execute
    Else
      MsgBox "Das Verzeichnis '" & strFavoritesFolder & "\" & strLinksFolder & "' enthält bereits einen Link " & ActiveWorkbook.Name & "!", vbExclamation
    End If
  Else
    MsgBox "Das Verzeichnis '" & strFavoritesFolder & "\" & strLinksFolder & "' konnte nicht gefunden werden!", vbExclamation
  End If
End Sub

	Verwandte Codebeispiele
	Verknüpfung mit Arbeitsmappendatei zu Favoriten hinzufügen Datei-Verknüpfung im Favoriten-Ordner erstellen

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Verknüpfung auf der Links-Symbolleiste des Internet Explorers löschen

.Beschreibung
Beschreibung folgt.

.VBA-Code
Public Sub DeleteLinkOfIELinksToolbar()
  Const strLinkToDelete As String = "WSH_Runtime-Test.xls"
  Dim strLinksFolder As String
  Dim strFavoritesFolder As String
  Dim objWSHShell As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  strFavoritesFolder = objWSHShell.SpecialFolders("favorites")
  strLinksFolder = objWSHShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Toolbar\LinksFolderName")
  Set objWSHShell = Nothing
  If strLinksFolder = "" Then
    strLinksFolder = "Links"
  End If
  If Dir(strFavoritesFolder & "\" & strLinksFolder, vbDirectory) <> "" Then
    If Dir(strFavoritesFolder & "\" & strLinksFolder & "\" & strLinkToDelete & ".url") <> "" Then
      Kill strFavoritesFolder & "\" & strLinksFolder & "\" & strLinkToDelete & ".url"
    Else
      MsgBox "Der Link '" & strLinkToDelete & "' konnte nicht gefunden werden!", vbExclamation
    End If
  Else
    MsgBox "Das Verzeichnis '" & strFavoritesFolder & "\" & strLinksFolder & "' konnte nicht gefunden werden!", vbExclamation
  End If
End Sub

	Weitere Informationen
	VBA-Spezialthema: Windows Script Host (WSH)

Datei-Hyperlink auf einem Arbeitsblatt erstellen

.Beschreibung
Beschreibung folgt.

Ab Excel 2000 wurde die Add-Methode erweitert.

Hyperlinks-Auflistung des Range- oder des Worksheet-Objektes.

.VBA-Code #1
Public Sub AddHyperlinkToSheet1()
  ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="C:\Daten\AndereMappe.xls"
End Sub

.VBA-Code #2
Public Sub AddHyperlinkToSheet2()
  ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:="C:\Daten\AndereMappe.xls"
End Sub

Internet-Hyperlink auf einem Arbeitsblatt erstellen

.Beschreibung
Beschreibung folgt.

Ab Excel 2000 wurde die Add-Methode erweitert.

Hyperlinks-Auflistung des Range- oder des Worksheet-Objektes.

TODO: Programmcode

.VBA-Code #1
Public Sub AddHyperlinkToSheet1()

End Sub

.VBA-Code #2
Public Sub AddHyperlinkToSheet2()

End Sub

Hyperlink-Basis-Verzeichnis einer Arbeitsmappe ändern

.Beschreibung
Mit der so genannten Hyperlink-Basis kann man ein Verzeichnis festlegen, welches als Basis für alle relativen Pfade von Hyperlinks in einer Arbeitsmappe verwendet wird. In Microsoft Excel wird die Hyperlink-Basis im Eigenschaften-Dialogfenster der Arbeitsmappe (Menü Datei/Eigenschaften) festgelegt. In einem VBA-Programm erreicht man diese Einstellung über die BuiltInDocumentProperties-Auflistung des Workbook-Objektes anhand des Bezeichners "Hyperlink base".

» Im Codebeispiel #1 wird die Hyperlink-Basis der aktiven Arbeitsmappe auf Verzeichnis "C:\Daten" eingestellt.

» Beim Codebeispiel #2 wird eine Internet-Adresse (URL) als Basis verwendet. Hierbei ist zu beachten, dass man die Adresse immer mit vorangestelltem "http://" einträgt, also zum Beispiel "http://www.xlam.info". Anderenfalls erkennt Excel die Angabe nicht als gültige Internet-Adresse.

» Das Codebeispiel #3 zeigt, wie man die Hyperlink-Basis löscht.

Bitte beachten Sie, dass auch ein nicht existierender Verzeichnispfad verwendet werden darf. Das ist beispielsweise dann nützlich, wenn das gewünschte Verzeichnis zum Zeitpunkt des Festlegens der Hyperlink-Basis nicht verfügbar ist, weil es sich zum Beispiel auf einem gerade nicht verbundenem Netzlaufwerk befindet. Man muss aber unbedingt wissen, wie Microsoft Excel bei einem nicht vorhandenen Hyperlink-Basis-Verzeichnis reagiert. Wird nämlich ein Hyperlink in eine Zelle eingefügt, 'übersieht' Excel den letzten Ordner im Pfad der Hyperlink-Basis. Lautet die Basis zum Beispiel "Z:\Excel\Teams" und gibt als Link-Zieldatei "Statistik.xls" ein, wird der Hyperlink mit "Z:\Excel\Statistik.xls" statt mit "Z:\Excel\Teams\Statistik.xls" erstellt. Dieses Problem kann man umgehen, indem man einen zusätzlichen Backslash ('\') an den Hyperlink-Basis-Pfad anhängt.

.VBA-Code #1
Public Sub SetHyperlinkBase1()
  ActiveWorkbook.BuiltInDocumentProperties("Hyperlink base").Value = "C:\Daten"
End Sub

.VBA-Code #2
Public Sub SetHyperlinkBase2()
  ActiveWorkbook.BuiltInDocumentProperties("Hyperlink base").Value = "http://www.xlam.info"
End Sub