begini kah ? (=pertanyaan ini mubazir karena pasti tidak an dijawab)
'-----------------
Sub ListFilesNameOfSpecifiedFolder()
'-------------------------------------------------------------
' siti Vi / mendaftar NamaFiles dari sebuah folder tertentu,
' ditulis di ActiveSheet's cells
'-------------------------------------------------------------
Dim fBrowser As BrowseInfo
Dim PathDirNm As String
Dim szTitle As String
Dim lpIDList As Long
Dim FSO As Object
Dim FOL As Object
Dim MyFile As Object
Dim r As Integer
'==== BAGIAN I: Urusan mencari Folder ================
'---- (user pilih folder melalui BrowseInfo)----------
szTitle = "©tv: Pilih salah satu Folder..."
With fBrowser
.hWndOwner = Application.Hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BI_RetuOnlyFSDir + BI_NoGoBelowDomain
End With
lpIDList = SHBrowseForFolder(fBrowser)
If (lpIDList) Then
PathDirNm = Space(Max_Path)
SHGetPathFromIDList lpIDList, PathDirNm
PathDirNm = Left(PathDirNm, InStr(PathDirNm, vbNullChar) - 1)
Range("D2") = PathDirNm ' hanya untuk info di sheet
End If
'-----------
' siti Vi / mendaftar NamaFiles dari sebuah folder tertentu,
' ditulis di ActiveSheet'
'-----------
Dim PathDirNm As String
Dim szTitle As String
Dim lpIDList As Long
Dim FSO As Object
Dim FOL As Object
Dim MyFile As Object
Dim r As Integer
'==== BAGIAN I: Urusan mencari Folder ============
'---- (user pilih folder melalui BrowseInfo)-
szTitle = "©tv: Pilih salah satu Folder..."
With fBrowser
.hWndOwner = Application.
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BI_RetuOnlyFSDir + BI_NoGoBelowDomain
End With
lpIDList = SHBrowseForFolder(
If (lpIDList) Then
PathDirNm = Space(Max_Path)
SHGetPathFromIDList lpIDList, PathDirNm
PathDirNm = Left(PathDirNm, InStr(PathDirNm, vbNullChar) - 1)
Range("D2") = PathDirNm ' hanya untuk info di sheet
End If
'==== BAGIAN II: ======================================
'---- Urusan mendaftar fileName ke sheet --------------
On Error GoTo Akhir
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FOL = FSO.GetFolder(PathDirNm).Files
' hapus area data
Range("b6").CurrentRegion.Offset(1, 0).ClearContents
' - kunjungi semua Anggota Koleksi (file)
For Each MyFile In FOL
r = r + 1
With Range("B6")
.Cells(r, 1) = r
' - ambil Name-nya !! Tulis di cell
.Cells(r, 2) = MyFile.Name
End With
Next
Akhir:
End Sub
'---- Urusan mendaftar fileName ke sheet ------------
On Error GoTo Akhir
Set FSO = CreateObject(
Set FOL = FSO.GetFolder(
' hapus area data
Range("b6").
' - kunjungi semua Anggota Koleksi (file)
For Each MyFile In FOL
r = r + 1
With Range("B6")
.Cells(r, 1) = r
' - ambil Name-nya !! Tulis di cell
.Cells(r, 2) = MyFile.Name
End With
Next
Akhir:
End Sub
----- Original Message -----From: gultomSent: Wednesday, December 09, 2009 2:14 PMSubject: ]] XL-mania [[ List folder d/l ke ExcelDear All,Waktu dulu pernah ada yang membuat macro list file di folderdi down load ke excel pake macroKalo ada yang masih simpan tolong bagi dong,karena saya punya hilang nihRegards,Gultom
__._,_.___
+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Setelah bang momods kawin bulan lalu... bulan ini tanggal |
| 2 Desember bu guru Siti Vi ulang tahun lhooo.... |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
| Setelah bang momods kawin bulan lalu... bulan ini tanggal |
| 2 Desember bu guru Siti Vi ulang tahun lhooo.... |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
MARKETPLACE
.
__,_._,___
Nenhum comentário:
Postar um comentário