vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Sch?tzen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
Rubrik: Excel   |   VB-Versionen: VBA15.12.14
Eine UserForm (VBA) zum Ändern der Liste "Zuletzt verwendete Dokumente" (Excel)

Gestattet die Änderung der Einträge oben genannter Liste im Falle einer Veränderung in den zugeordneten Laufwerksbuchstaben von Listeneinträgen.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  5.424 
ohne HomepageSystem:  Win7, Win8, Win10 Beispielprojekt 

Hin und wieder hatte ich das Problem, dass sich die Laufwerksbuchstaben meiner externen Festplatten (USB) änderten, wenn man noch zusätzliche USB-Datenträger eingesteckt hat. In diesm Fall "passen" manche Einträge der genannten Liste nicht mehr, weil die Laufwerksbuchstaben nicht mehr identisch sind.

Die vorgestellte UserForm mit dem integrierten Code ermöglicht, dass die betreffenden Listeneinträge geändert werden können. Man kann das Laufwerk auswählen, das jetzt in den Pfaden der Listeneinträge eingefügt werden soll. In der Liste der zuletzt verwendeten Dokomente (UserForm) markiert man die zu ändernden Einträge und klickt dann auf "ausführen". Danach stehen die Listeneinträge mit der geänderten Laufwerks-Verknüpfung zur Verfügung.

Leider kann diese UserForm in dieser Weise nur unter Excel angewandt werden, MS-Word und Powerpoint bspw. bieten in deren VBA nicht die Eigenschaften der RecentFilesList.

Getestet wurde nachfolgender Code nur unter Excel2007.

Option Explicit
' neuer Laufwerksname (new drive name)
Dim strNewDrive As String
 
' alle Laufwerke und Typ auflisten (list all the drives and their types)
Sub DriveTypeAndList()  
  Dim objDrv As Object
  With lstDrives
    For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
      Select Case objDrv.DriveType
        Case 0:
          .AddItem (objDrv.DriveLetter & ": (" & objDrv.VolumeName & ")" & " - (Unknown)")
        Case 1:
          .AddItem (objDrv.DriveLetter & ": (" & objDrv.VolumeName & ")" & " - (Removable)")
        Case 2:
          .AddItem (objDrv.DriveLetter & ": (" & objDrv.VolumeName & ")" & " - (Hard-Disk)")
        Case 3:
          .AddItem (objDrv.DriveLetter & ": (" & objDrv.VolumeName & ")" & " - (Network)")
        Case 4: 
          .AddItem (objDrv.DriveLetter & ": (CD-ROM)")
        Case 5:
          .AddItem (objDrv.DriveLetter & ": (" & objDrv.VolumeName & ")" & " - (RAM-Disk)")
      End Select
    Next 
  End With
  Set objDrv = Nothing
End Sub
 
' alle RecentFiles auflisten (list all the RecentFiles names)
Sub getRecentFiles()
  Dim i As Integer, strn, strp As String
  With Application.RecentFiles
    For i = 1 To .Count
      strn = .Item(i).Name
      strp = .Item(i).Path
      lstRecentFiles.AddItem strp 'hinzufügen des geänderten RecentFiles
    Next i
  End With
End Sub
 
' gegebenenfalls das markierte RecentFile mit neuem Laufwerk listen
' (lists the marked RecentFiles with a new drive name)
Sub ChangeRecentFiles() 
  Dim strPath, strName As String
  Dim strNewPath, strNewName As String
  Dim i As Integer
  For i = 0 To lstRecentFiles.ListCount - 1
    ' ist die Datei in der Listbox markiert
    ' (is the file marked in the listbox)
    If lstRecentFiles.Selected(i) = True Then
      ' wenn ja (if yes):
      With Application.RecentFiles
        strName = .Item(i + 1).Name
        strPath = .Item(i + 1).Path
        strNewPath = strNewDrive & Right(strPath, Len(strPath) - 2)
 
        ' löschen des alten Listeneintrags (delete the old list item)
        .Item(i + 1).Delete
 
        ' hinzufügen des neuen Listeneintrags (add the new list item)
        .Add Name:=strNewPath
      End With
    End If
  Next i
End Sub
 
' Button 'abbrechen' (cancel button)
Private Sub CommandButton1_Click()
  Unload Me
End Sub
 
' Button 'ausführen' (do button)
Private Sub CommandButton2_Click()
  Dim idx As Integer
  idx = lstDrives.ListIndex
  ' ist neues Laufwerk markiert (is a new drive marked)
  If idx >= 0 Then
    strNewDrive = Left(lstDrives.Value, 2)
    ' die Änderungen ausführen (do the changes)
    ChangeRecentFiles
    lstRecentFiles.Clear
    ' die neuen Listeinträge anzeigen (show the new list items)
    getRecentFiles
  Else
    ' (no drive choosen!)
    MsgBox ("Kein Laufwerk ausgewählt!")
  End If
End Sub
 
Private Sub UserForm_Activate()
  ' Liste der Laufwerke erzeugen (get a list of drives)
  DriveTypeAndList
  ' Liste der RecentFiles erzeugen (get a list of the RecentFiles)
  getRecentFiles
End Sub

Dieser Tipp wurde bereits 5.424 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2018 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel