VBA - Zwischenteil in Dateinamen ändern?

Hi zusammen,

ich muss folgende Dateinamen per Skriptfür rund 1000 Dateien wie folgt ändern:

Von:

3220022-8006-Amager_25_5_citrus-D-00

In:

3220022_8006_P_1

Den letzten Teil also D-00 in P_1 habe ich bereits hinbekommen. Wie ich jetzt aber alles nach dem ersten Zahlenpaar lösche weiß ich nicht.

Mein bisheriges Skript:

Sub Ordner_Auslesen()

'Bibliothek aktivieren

'Variablen dimensionieren

Dim fso As New FileSystemObject

Dim Pfad As String

Dim Ordner As Files

Dim Datei As File

'Pfad auslesen

Pfad = Tabelle1.Range("A1").Value

'Existiert der Ordner?

If fso.FolderExists(Pfad) Then

'Alle Dateien des Ordners einlesen

Set Ordner = fso.GetFolder(Pfad).Files

'Schleife über alle Dateien des Ordners

For Each Datei In Ordner

'Datei ausgeben

'Debug.Print Datei.Name

'Datei umbenennen

If InStr(Datei.Name, "D-00") <> 0 Then

Datei.Name = Replace(Datei.Name, "D-00", "P_1")

End If

Next Datei

Else

MsgBox "Dieser Ordner existiert nicht."

End If

End Sub

Kann mir jemand helfen?

2 Antworten

Oubyi, UserMod Light

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

09.02.2023, 12:54

Mal vom "Prinzip" her. Wenn die Ziffernfolge immer 12 Zeichen lang ist, wie hier, wäre es dann nicht einfacher, den Rest abzuschneiden, das _P_1 anzuhängen und den Bindestrich durch einen Unterstrich zu ersetzen?!
Oder Du liest die beiden Ziffernblöcke getrennt aus und setzt sie dann mit Unterstrich und dem Anhängsel neu zusammen!?

Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)

svdeschoeni

Fragesteller

09.02.2023, 13:10

Das habe ich auch schon gedacht, ich bin in VBA aber noch relativ neu und habs nicht hinbekommen.

hannes1806

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

10.02.2023, 09:33

Um das zu beantworten, brauchen wir entweder viel mehr Beispiele oder eine Regel.

Hilft es, wenn du den Dateinamen nach dem 2. Minuszeichen abschneiden kannst? Das ginge so:

Datei_abgeschnitten = Left(Datei.Name, InStr(InStr(Datei.Name, "-") + 1, Datei.Name, "-") - 1)

Woher ich das weiß:eigene Erfahrung – Faulheit >> Neugier >> Wissen

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zur Frage

Excel: Wie gestalte ich dieses Makro schneller und effektiver und sorge dafür, dass es bei Neustart nur neue Werte erkennt?

Wie kann ich dieses Makro schneller und effektiver machen und wie bekomme ich es hin, dass es beim Neustart nicht schon wieder die Werte erkennt, die schon einmal dran waren? Sodass die 50 nach dem ersten Mal Abspielen des Sounds ignoriert wird.

Code:

Sub PlaySound()
  Dim ws As Worksheet
  Dim rng As Range
  Dim cell As Range
  Dim goals As Long
  Dim soundFile As String
  Dim thresholds As Variant
  Dim i As Integer
  Set ws = ThisWorkbook.Worksheets("Spielplan")
  Set rng = ws.Range("O1:O" & ws.Cells(ws.Rows.Count, "O").End(xlUp).row)
  soundFile = "Sound_pfad.mp3"
  'Array of threshold values
  thresholds = Array(50, 100, 150, 200, 250, 300, 350, 400, 450, 500,550,600,650,700,750,800,850,900,950,1000)
  Do While True 'Endlosschleife hinzugefügt
    For Each cell In rng
      If IsNumeric(cell.Value) Then
        goals = goals + cell.Value
        'Check if goals is equal to any of the threshold values
        For i = LBound(thresholds) To UBound(thresholds)
          If goals = thresholds(i) Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            ActiveSheet.OLEObjects.Add(Filename:=soundFile, Link:=False, DisplayAsIcon:=False).Select
            Selection.Verb Verb:=xlPrimary
            Selection.Delete
            Application.ScreenUpdating = True
            Application.EnableEvents = True
          End If
        Next i
      End If
    Next cell
    'Verzögerung hinzugefügt, um die CPU-Auslastung zu reduzieren
    Application.Wait (Now + TimeValue("0:05:00"))
  Loop
End Sub

...zur Frage

Das Tabellenblatt öffnet sich nicht?

Hallo, ich habe Button womit ich eine Datei und darin direkt eine Eingabemaske öffnen will. Mein bisheriger Code aktiviert / öffnet die Datei, was mir fehlt, ist die direkte Anzeige der Eingabemaske. Ich stelle den Code mal hier ein, um vielleicht eine Lösung zu erhalten. Ich komme einfach nicht weiter.


Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim passwort As String
    Dim pfad_zur_datei As String
    Dim wb As Workbook
    Dim bestaetigung As VbMsgBoxResult

    ' Bestätigungsnachricht anzeigen und Passwort abfragen
    bestaetigung = MsgBox("Möchten Sie fortfahren?", vbQuestion + vbYesNo, "Bestätigung")

    ' Wenn der Benutzer auf "Ja" klickt
    If bestaetigung = vbYes Then
        passwort = InputBox("Geben Sie das Passwort ein:", "Passwortabfrage")

        ' Überprüfe das eingegebene Passwort
        If passwort = "123" Then ' Ersetze "dein_passwort" durch das gewünschte Passwort
            ' Konstruiere den vollständigen Pfad zur Datei
            pfad_zur_datei = "G:\NEU Reduziert für DEMO.xlsm" ' Passe den Pfad an

            ' Überprüfe, ob das Arbeitsblatt "Auswahlklick" existiert
            On Error Resume Next
            Set ws = Workbooks.Open(pfad_zur_datei).Worksheets("Auswahlklick")
            On Error GoTo 0

            ' Wenn das Arbeitsblatt existiert, aktiviere es
            If Not ws Is Nothing Then
                ws.Activate
            Else
                MsgBox "Das Arbeitsblatt 'Auswahlklick' wurde nicht gefunden.", vbExclamation
                Exit Sub
            End If
        Else
            MsgBox "Falsches Passwort. Der Zugriff wurde verweigert.", vbExclamation
            Exit Sub
        End If
    Else
        MsgBox "Vorgang abgebrochen.", vbInformation
        Exit Sub
    End If

    ' Hier den restlichen Code ausführen, der auf dem geöffneten Arbeitsblatt "ws" basiert

End Sub

...zur Frage

Name + User?

Hallo,

was müsste ich hier anpassen? Ich komme mit der Fehler Meldung nicht zurecht.

Private Declare 36 GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetNTUserA() As String
  
 Dim sBuffer As String
 Dim LSize As Long
 Dim user As String
  
 sBuffer = Space$(255)
 LSize = Len(sBuffer)
  
 Call GetUserName(sBuffer, LSize)
  
 If LSize > 0 Then
  user = Left$(sBuffer, LSize - 1)
 Else
  user = vbNullString
 End If
  
 GetNTUserA = user
  
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Column = 6 Then
    Target.Offset(0, 11).Value = Date
  End If
      
    If Target.Column = 6 Then
    Target.Offset(0, 10).Value = GetNTUserA
  End If

End Sub

...zur Frage

Batch: Wie setzt man den vollständigen Dateinamen einer mit "if exist" und Wildcard-Asterisk gefundenen Datei in eine Variable?

Es soll geprüft werden, ob sich in einem bestimmten Ordner eine Datei wie "GL(2023.05.05).zip" befindet. Die Zahlen im Dateinamen sind nicht bekannt.

"If exist %MEIN_ORDNER%GL(*.*.*).zip" findet die Datei, aber wie kann ich jetzt den tatsächlichen Dateinamen in eine Variable eintragen? Also sowas wie
If exist %MEIN_ORDNER%GL(*.*.*).zip set DATEINAME= ????

...zur Frage

[VBA] - Multipage Userform eingaben in Excel übertragen?

Servus Leute,

Ich habe ein Userform in Excel mit Multipage erstellt.

Nun möchte ich auf der letzten Multipage Seite einen Button einbauen. Auf Knopfdruck sollen dann alle Eingaben die vom User auf den einzelnen Multipageseiten gemacht worden sind in ein Excel Tabellenblatt übertragen werden.

Mein Ansatz war dem Button folgenden Code zu geben:

    Dim sheet2 As Worksheet
    Dim maxRow2 As Long
    Dim check3 As Boolean
    Set sheet2 = ActiveWorkbook.Worksheets(1)
    maxRow2 = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row
    If CheckBox1.Value Then
      sheet2.Cells(maxRow2 + 1, 9).Value = "ja"
      Else
        sheet2.Cells(maxRow2 + 1, 9).Value = "nein"
        End If
              sheet2.Cells(maxRow2 + 1, 13).Value = TextBox4.Value

Das funktioniert leider nicht wie ich es mir erhofft habe, auf Knopfdruck werden keine Daten übertragen. Ich habe die vermutung, dass nicht auf die Felder wie z.B. TextBox4 zugegriffen werden kann, weil die auf einer anderen Seite im Multipage sind.

Wie schaffe ich es an die Variablen ranzukommen. Ich hatte noch überlegt, im Code der jeweiligen Seite den Wert aus der Textbox in eine Variable zu setzen, die z.B. Global ist. Aber da bin ich auch schon wieder überfragt wie man das macht.

Außerdem habe ich noch eine Frage zu den Checkboxen.

Es soll folgende Möglichkeiten geben:

Wenn Checkbox nicht angeklickt, dann kann man immer zu nächsten Kategorie ( Nächste Seite im Multipage)
Wenn Checkbox angeklickt ist und variable x leer, dann soll man nicht weiter kommen (Msgbox)
Wenn Checkbox angeklickt ist und variable x befüllt, dann kann man zur nächsten Kategorie (Nächste Seite im Multipage)

Für eine Checkbox habe ich das schon hinbekommen, aber wie mach ich das wenn es mehrere Checkboxen gibt. Weil ich glaube wenn ich das so mache wie bisher, dann wird das eine endlose anreihung von if bedingungen.

Diesen Code habe ich dann auf den Button gelegt, mit dem man zur nächsten Kategorie kommen soll oder eben halt nicht.

  Dim sheet2 As Worksheet
    Dim maxRow2 As Long
    Dim check3 As Boolean
    Set sheet2 = ActiveWorkbook.Worksheets(1)
    maxRow2 = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row
   
    If CheckBox3.Value Then
    If Test = False Then
    MsgBox ("Kein Pfad angegeben")
    Else
  Dim iNextPage As Long
    With Me.MultiPage1
        iNextPage = .Value + 1
        If iNextPage < .Pages.Count Then
            .Pages(iNextPage).Visible = True
            .Value = iNextPage
        End If
    End With
    End If
    Else
    Dim iNextPage2 As Long
    With Me.MultiPage1
        iNextPage2 = .Value + 1
        If iNextPage2 < .Pages.Count Then
            .Pages(iNextPage2).Visible = True
            .Value = iNextPage2
        End If
    End With
    End If

Und als letztes würde ich gern noch wissen ob es möglich ist, zu unterbinden, dass der User oben im Multipage die Kategorie direkt anklicken kann und man halt nur über den "weiter" button zur nächsten kategorie kommt.

Gruß Chris

...zur Frage

Excel Über Macro Bilder ohne Link einbetten?

Hallo zusammen,

ich möchte für einen Kunden eine Produktübersicht mit Bildern erstellen. Die Bilder ziehe ich mir über folgenden Code:

Sub InsertPics()
  Dim Rw&, PFAD$, Datei$, Bild As Shape
  PFAD = "C:\test\"
  With ActiveSheet
    For Rw = 32 To 47
      Datei = .Range("G" & Rw) & ".jpg"
      If Dir(PFAD & Datei) <> vbNullString Then
        .Pictures.Insert (PFAD & Datei)
        Set Bild = .Shapes(.Shapes.Count)
        Bild.LockAspectRatio = msoFalse
        Bild.Left = .Range("A" & Rw).Left
        Bild.Top = .Range("A" & Rw).Top
        Bild.Width = .Range("A" & Rw).Width
        Bild.Height = .Range("A" & Rw).Height
      End If
    Next
  End With
End Sub

Welcher auf wunderbar funktioniert. Einziges Problem: Die Bilder werden nur verlinkt und nicht kopiert. Sobald ich die Datei versende, sind die Bilder nicht mehr sichtbar. Wie muss ich den Code verändern, um die Bilder gleich zu kopieren? Ist das möglich?

Danke für jede Antwort.

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

Excel-Code für Mehrfachauswahl in Dropdown-Listen?

Hallo zusammen,

Ich versuche gerade ein Excel-Dokument zu erstellen, bei dem eine Mehrfachauswahl aus Dropdown-Listen möglich ist. Das heißt aus einer Liste sollte es möglich sein mehrere Werte anzuwählen. Das habe ich auch mit dem untenstehenden VisualBasic-Code gemeistert. Allerdings habe ich erstens das Problem, dass auch eine Mehrfachauswahl des immer gleichen Wertes möglich ist. Theoretisch könnte also in einer Zelle x-mal derselbe Werte auftauchen. Dies soll natürlich nicht möglich sein. Bei Doppelauswahl desselben Wertes soll dieser aus der Zelle wieder verschwinden.

Mein zweites Problem ist, dass ich bislang nur 2 zwei Dropdown-Listen mit Mehrfachauswahl eingefügt bekomme. Sobald ich eine dritte Spalte versuche zu implementieren, bekomme ich eine Fehlermeldung für meinen Code.

Dadurch, dass ich mich mit dem Ganzen nicht so wirklich auskenne, wäre es sehr nett, wenn mir jemand helfen könnte.

Danke!

Bisheriger Code:

Private Sub Worksheet_Change(ByVal Target As Range)

** Mehrfachauswahl über DropDown-Liste

'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen

Dim rngDV As Range

Dim wert_old As String

Dim wertnew As String

'** Errorhandling

On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich "Abteilungen" und "Themen" (Bsp. J2:J2000, I2:I2000) durchführen

If Not Application.Intersect(Target, Range("J2:J2000", "I2:I2000")) Is Nothing Then

'**Range definieren

Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)

If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen

If Not Application.Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

wertnew = Target.Value

Application.Undo

wertold = Target.Value

Target.Value = wertnew

If wertold <> "" Then

If wertnew <> "" Then

Target.Value = wertold & ", " & wertnew

End If

Application.EnableEvents = True

End If

Errorhandling:

Application.EnableEvents = True

End Sub

...zur Frage

An Bedingungen gebundenes ausblenden von Zeilen?

Ich habe ein Problem, welches ich alleine nicht schaffe zu lösen.

Ich habe eine Exceltabelle mit einem Button "Closed ausblenden".
Bisher funktioniert es soweit, dass er alle in Spalte N "Closed" ausblendet.

Code ist bis jetzt so:

Private Sub ToggleButton4_Click()

If Me.ToggleButton4.Value = True Then

Dim Liste As Range

Dim lngCriteriaCount As Long

Dim arrCriteria() As String

Dim oLO As ListObject

Application.EnableEvents = True

For r = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(r, 14).Value, "CLOSED") Then

Rows(r).RowHeight = 0

End If

Next

Me.ToggleButton4.Caption = "'CLOSED' ausgeblendet"

Else

For l = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(l, 14).Value, "CLOSED") Then

Rows(l).RowHeight = 12

End If

Next

Me.ToggleButton4.Caption = "'closed' ausblenden"

End If

End Sub

Nun soll es erweitert werden:
Es soll nicht nur die Zeile sondern auch alle nachfolgenden Zeilen ausgeblendet werden - bis das Wort "Topic" oder "Topic ll" erreicht wird.

In diesem Beispiel also das gelb markierte mit ausblenden.

Kann mir jemand helfen?

...zur Frage

Excel Makro, PDF versenden, Anhang klappt nicht?

Hallo, ich würde gerne eine Rechnung mit einem Makro erstellen. Soweit klappt das auch und die Mail öffnet sich auch, aber diese wird nicht als Anhang hinzugefügt. Ich komme leider nicht drauf. Ich denke, es liegt daran, dass er die Datei nicht findet, aber ich wüsste keinen Lösungsansatz. Hier der Code:

Dim Result As VbMsgBoxResult

Sub RechnungsnrUndDrucken()

Sheets("Rechnung_Video").Select

[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen

Dim sCC As String

Dim sName As String

Dim sText As String

Dim sObject As String

Dim sCompany As String

Dim sRefNr As String

Dim sTempFileName As String

If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then

Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)

If Result = vbNo Then Exit Sub

End If

Const DateiPfad = "C:\Temp\"

Dim DateiName As String

DateiName = DateiPfad & Range("C15") & Range("D15") & ".pdf"

Range("A1:F54").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

DateiName, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Dim Nachricht As Object, OutApp As Object

Dim AWS As String

Set OutApp = CreateObject("Outlook.Application")

AWS = strFileName

'InitializeOutlook = True

Set Nachricht = OutApp.CreateItem(0)

With Nachricht

.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")

.GetInspector.display

'.Attachments.Add ("C:\Temp\" & Range("C15") & Range("D15") & ".pdf")

End With

Set OutApp = Nothing

Set Nachricht = Nothing

End Sub

...zur Frage

Bei Serienbrief Dokumente einzeln Speichern mit Makro funktioniert nicht?

Ich möchte die Dokumente im Serienbrief einzeln automatisch speichern mittels Makro und habe das unten angefügte Makro dafür auch gefunden aber es funktioniert bei mir noch nicht sondern debugt immer und zeigt Fehler in der Variable an. Ich hab auch den Pfad schon auf mein Dokument angepasst. Muss ich evtl noch den Dateinamen ändern?

Sub Test()
 '
 ' Serienbrief in einzelnen Word Dokumenten speichern
 '
 Dim Dateiname As String
 Dim LetzterRec As Long
     
 Application.ScreenUpdating = False
 Application.Visible = False

 Const path As String = "C:\Test\"          'Pfad anpassen
 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
 LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord
 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord


     With ActiveDocument.MailMerge
         .DataSource.ActiveRecord = wdFirstRecord
         Do
             If .DataSource.ActiveRecord > 0 Then
                If .DataSource.DataFields("VorNachname").Value <> "0" Then
                     .Destination = wdSendToNewDocument
                    .SuppressBlankLines = True

                     With .DataSource
                         .FirstRecord = .ActiveRecord
                         .LastRecord = .ActiveRecord
                
                         Dateiname = path & .DataFields("VorNachname").Value & ".docx"
                
                     End With
                        .Execute Pause:=False
                 
                         ActiveDocument.SaveAs FileName:=Dateiname           'Speichern unter Dateiname
                        ActiveDocument.Close False
                 End If

               End If
               
             If .DataSource.ActiveRecord < LetzterRec Then
                 .DataSource.ActiveRecord = wdNextRecord
             Else
                 Exit Do
             End If
         Loop
     End With
     
     Application.Visible = True
     Application.ScreenUpdating = True
 End Sub

...zur Frage

Mit VBA Dateien in einem Ordner umbenennen?

Ich habe es mithilfe vom Internet und einigen sehr wenigen Kenntnissen meinerseits geschafft, mir einen Code zu schreiben, mit dem ich Dateien (Fotos - also JPG-Dateien) umbenennen kann. Leider habe ich einen Teil des Codes gelöscht und dies gespeichert. Somit funktioniert leider gar nichts mehr und ich bekommen immer den Fehler, dass die Datei nicht gefunden werden kann. Die Meldung bekomme ich immer in der Zeile "Name File.Name As x".

Kann mir bitte jemand helfen?

Hier mein Code:

  Shell "Explorer.exe C:\Users\LANGEMIC.HILTI\Documents\Temp, vbNormalFocus"
  Set FS = CreateObject("Scripting.FileSystemObject")
  Set Folder = FS.GetFolder("C:\Users\LANGEMIC.HILTI\Documents\temp")
  
  Dim x As Single
  x = ActiveCell
  
  For Each File In Folder.Files
    If File.Name Like ".jpg" Then
      ActiveCell.Offset(1, 0).Select
      x = ActiveCell
      Name File.Name As x
      End If
  Next
End Sub

...zur Frage

Makro für das importieren von Dateinamen mit Hyperlinks aus einem Ordner und seine Unterordnern?

Hallo zusammen,

ich würde gerne eine Excel erstellen in der ich aus einem Ordner und seinen Unterordnern die Dateinamen auflisten kann, mit Hyperlinks ohne Dateipfad nur mit dem Namen der Datei. Dan nach würde ich gerne diese Dateinamen mit den Einträgen einer anderen Zeile verbinden, sodass wenn der Dateiname der importierten Dateien z. B. Apfel ist und in einer andern Zeile auch Apfel steht, diese automatisch in dieselbe Spalte sortiert werden. Gibt es dazu einen Makro code denn ich benutzen könnte oder irgendwie andere Optionen? Die exportierten Dateinamen sollen übrigen in eine bestimmte Spalte und nicht ganz am Anfang der Tabelle stehen.

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen