specify file path and extension list in detail Free Excel Macros (VBA) | Excel Programs

Copy Macro

'For online Excel courses click: https://www.excelsizeyeter.com/excelwithkenan.com/udemy_giris.php 
 
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private z!

Function GetDirectory(Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
With bInfo
    .pidlRoot = 0&
    .lpszTitle = Msg
    .ulFlags = &H1
End With
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
    pos = InStr(path, Chr$(0))
    GetDirectory = Left(path, pos - 1)
Else
    GetDirectory = ""
End If
End Function

Sub Dateisuche(Laufwerk, Dateien)
Dim tmp, Wdhlg, Dateiname As String
On Error Resume Next
If Right(Laufwerk, 1)  "" Then Laufwerk = Laufwerk + ""
tmp = Dir(Laufwerk & Dateien)
Do While Len(tmp)
    Dateiname = Laufwerk & tmp
    Application.StatusBar = Dateiname
    Cells(z, 1).Select
    Cells(z, 1) = Laufwerk & tmp 'Pfad
    Cells(z, 2) = FileLen(Laufwerk & tmp) 'Größe
    Cells(z, 3) = FileDateTime(Laufwerk & tmp) 'Datum/Zeit
    Cells(z, 4) = tmp 'nur Dateiname
    z = z + 1
    tmp = Dir()
Loop
tmp = Dir(Laufwerk, vbDirectory)
Do While Len(tmp)
    If (tmp  ".") And (tmp  "..") Then
        If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
            Dateisuche Laufwerk & tmp, Dateien
            z = z - 1
            Wdhlg = Dir(Laufwerk, vbDirectory)
            z = z + 1
            Do While Wdhlg  tmp
                Wdhlg = Dir()
            Loop
        End If
    End If
    tmp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub

Sub Suchen()
Dim Laufwerk$, Dateien$
'Ersze Zeile, in der eine Eintragung erfolgt
z = 2
'Alte Eintragungen löschen
[a1:e5000] = ""
'Ersatz: ... = "C:Eigene Dateien"
Laufwerk = GetDirectory("Bitte einen Ordner wählen")
If Laufwerk = "" Then Exit Sub
'Ersatz: Dateien = "*.*"
Dateien = InputBox("Nach welchen Dateien soll in" & _
    Chr(10) & " " & Laufwerk & Chr(10) & _
    "gesucht werden (z. B. *.xls)?", _
    "Dateityp", "*.*")
If Dateien = "" Then Exit Sub
Dateisuche Laufwerk, Dateien
End Sub

No	Macro Name
1	specify file path and extension list in detail
2	excel operators hk
3	specify partition, list how many files you have
4	show file path list in detail fields of files file path etcâ € ¦
5	a .bat file from a floppy disk
6	lists xls files in the specified path from the active cell
7	browse folder xls list
8	records detailed formatted cells on the records sheet / page
9	prints the path and name of the file to the cell
10	specifies in detail how many references the book contains (on new sheet / page)
11	specifies in detail how many formulas are in the book (on new sheet / page)
12	desktop icon creation
13	create shortcut to desktop
14	opening calculator
15	save book you specify name - notifies you by message
16	send alert e-mail from microsoft outlook
17	Specifies the path and name of the book
18	Send or bulk mail with Outlook
19	a worksheet and create a hyperlink from a folder
20	inserts months as sheet / pages Specifies days in detail

Excel Free Macros (VBA)

Specify File Path And Extension List İn Detail

Online Excel Courses

Services

How can we help you?

Subscribe to our Youtube Channel?

Keywords