Klasörde numara vermek

[muratgunay48]

Arkadaşlar, sayın hocalarım, farkındayım çok sorular soruyorum. Bunlardan çoğu hep işimi biraz daha kolaylaştırmak için. Basın sektöründe çalıştığım için.
Haftalardır elle yapıyorum ama Excel ile yapmak mümkün mü diye düşündüm. Ben haftanın 3 günü dergi indiriyorum.
Burası önemli. Tek seferde değil. Sayfa sayfa indiriyorum. 1'den başlayarak. Sayfalar PNG, JPG, JPEG olarak iniyor.
Sayfalar inerken çok tuhaf isimle iniyor. Programdan ötürü. Mesela "chrome_8LtlbYWe1g" bu bir sayfa ismi.
Ancak klasörü ARTAN SIRA ve DEĞİŞTİRME TARİHİNE göre sıralarsam. Düzgün sıralıyor. Kontrol ettim. Kalıyor numara vermek.
Öğrenmek istediğim şu; bu şekilde sıralatıp ve daha sonra 1'den başlayarak sona kadar numara verecek bir makro yazılabilir mi? Sabit değil. Bazen 70 sayfa oluyor bazen 150.
Eğer yardımcı olursanız müteşekkir olurum.
Saygılarımla.

 

[hamitcan]

Bu şekilde deneyin. Ben masaüstünde denedim, çalıştı.
Sub HtmlDosyalariniTariheGoreAdlandir()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim masaustuYolu As String
Dim dosyaListesi() As Variant
Dim dosyaSayisi As Integer
Dim i As Integer, j As Integer
Dim geciciTarih As Date
Dim geciciYol As String
Dim yeniIsim As String

' FileSystemObject nesnesini oluştur
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Kullanıcının masaüstü yolunu otomatik olarak bul

masaustuYolu = CreateObject("WScript.Shell").SpecialFolders("desktop")
Set objFolder = objFSO.GetFolder(masaustuYolu)

dosyaSayisi = 0

' Masaüstündeki sadece .html uzantılı dosyaları bul ve diziye kaydet
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "html" Then
dosyaSayisi = dosyaSayisi + 1
ReDim Preserve dosyaListesi(1 To 2, 1 To dosyaSayisi)

dosyaListesi(1, dosyaSayisi) = objFile.Path
' DateCreated: İndirme/Oluşturulma tarihi. (İhtiyaca göre DateLastModified yapılabilir)
dosyaListesi(2, dosyaSayisi) = objFile.DateCreated
End If
Next objFile

' Eğer HTML dosyası bulunamazsa işlemi sonlandır
If dosyaSayisi = 0 Then
MsgBox "Masaüstünde .html uzantılı dosya bulunamadı.", vbExclamation, "İşlem İptal"
Exit Sub
End If

' Dosyaları indirme tarihine göre (Eskiden Yeniye) sırala (Bubble Sort)
For i = 1 To dosyaSayisi - 1
For j = i + 1 To dosyaSayisi
If dosyaListesi(2, i) > dosyaListesi(2, j) Then
' Tarihleri yer değiştir
geciciTarih = dosyaListesi(2, i)
dosyaListesi(2, i) = dosyaListesi(2, j)
dosyaListesi(2, j) = geciciTarih

' Dosya yollarını yer değiştir
geciciYol = dosyaListesi(1, i)
dosyaListesi(1, i) = dosyaListesi(1, j)
dosyaListesi(1, j) = geciciYol
End If
Next j
Next i

' ÇAKIŞMA ÖNLEME 1. AŞAMA:
' Mevcutta 1.html, 2.html gibi dosyalar varsa hata vermemesi için önce "gecici_" önekiyle adlandır.
For i = 1 To dosyaSayisi
yeniIsim = masaustuYolu & "\gecici_isim_" & i & ".html"
If objFSO.FileExists(yeniIsim) Then Kill yeniIsim ' Eğer eskiden kalma geçici dosya varsa sil
Name dosyaListesi(1, i) As yeniIsim
dosyaListesi(1, i) = yeniIsim ' Yeni yolu diziye kaydet
Next i

' ÇAKIŞMA ÖNLEME 2. AŞAMA:
' Geçici adlandırılan dosyaları nihai 1.html, 2.html formatına çevir.
For i = 1 To dosyaSayisi
yeniIsim = masaustuYolu & "\" & i & ".html"
If objFSO.FileExists(yeniIsim) Then Kill yeniIsim ' Önlem amaçlı temizlik
Name dosyaListesi(1, i) As yeniIsim
Next i

MsgBox dosyaSayisi & " adet HTML dosyasının ismi indirme sırasına göre başarıyla değiştirildi!", vbInformation, "İşlem Tamamlandı"

' Hafızayı temizle
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub

 

[volki_112]

Arkadaşlar, sayın hocalarım, farkındayım çok sorular soruyorum. Bunlardan çoğu hep işimi biraz daha kolaylaştırmak için. Basın sektöründe çalıştığım için.
Haftalardır elle yapıyorum ama Excel ile yapmak mümkün mü diye düşündüm. Ben haftanın 3 günü dergi indiriyorum.
Burası önemli. Tek seferde değil. Sayfa sayfa indiriyorum. 1'den başlayarak.
Sayfalar inerken çok tuhaf isimle iniyor. Programdan ötürü. Mesela "chrome_8LtlbYWe1g" bu bir sayfa ismi.
Ancak klasörü ARTAN SIRA ve DEĞİŞTİRME TARİHİNE göre sıralarsam. Düzgün sıralıyor. Kontrol ettim. Kalıyor numara vermek.
Öğrenmek istediğim şu; bu şekilde sıralatıp ve daha sonra 1'den başlayarak sona kadar numara verecek bir makro yazılabilir mi? Sabit değil. Bazen 70 sayfa oluyor bazen 150.
Eğer yardımcı olursanız müteşekkir olurum.
Saygılarımla.

bu videoyu izleyiniz. makroya gerek kalmadan da yapılabilir.

 

[muratgunay48]

Bu şekilde deneyin. Ben masaüstünde denedim, çalıştı.
Sub HtmlDosyalariniTariheGoreAdlandir()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim masaustuYolu As String
Dim dosyaListesi() As Variant
Dim dosyaSayisi As Integer
Dim i As Integer, j As Integer
Dim geciciTarih As Date
Dim geciciYol As String
Dim yeniIsim As String

' FileSystemObject nesnesini oluştur
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Kullanıcının masaüstü yolunu otomatik olarak bul

masaustuYolu = CreateObject("WScript.Shell").SpecialFolders("desktop")
Set objFolder = objFSO.GetFolder(masaustuYolu)

dosyaSayisi = 0

' Masaüstündeki sadece .html uzantılı dosyaları bul ve diziye kaydet
For Each objFile In objFolder.Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "html" Then
dosyaSayisi = dosyaSayisi + 1
ReDim Preserve dosyaListesi(1 To 2, 1 To dosyaSayisi)

dosyaListesi(1, dosyaSayisi) = objFile.Path
' DateCreated: İndirme/Oluşturulma tarihi. (İhtiyaca göre DateLastModified yapılabilir)
dosyaListesi(2, dosyaSayisi) = objFile.DateCreated
End If
Next objFile

' Eğer HTML dosyası bulunamazsa işlemi sonlandır
If dosyaSayisi = 0 Then
MsgBox "Masaüstünde .html uzantılı dosya bulunamadı.", vbExclamation, "İşlem İptal"
Exit Sub
End If

' Dosyaları indirme tarihine göre (Eskiden Yeniye) sırala (Bubble Sort)
For i = 1 To dosyaSayisi - 1
For j = i + 1 To dosyaSayisi
If dosyaListesi(2, i) > dosyaListesi(2, j) Then
' Tarihleri yer değiştir
geciciTarih = dosyaListesi(2, i)
dosyaListesi(2, i) = dosyaListesi(2, j)
dosyaListesi(2, j) = geciciTarih

' Dosya yollarını yer değiştir
geciciYol = dosyaListesi(1, i)
dosyaListesi(1, i) = dosyaListesi(1, j)
dosyaListesi(1, j) = geciciYol
End If
Next j
Next i

' ÇAKIŞMA ÖNLEME 1. AŞAMA:
' Mevcutta 1.html, 2.html gibi dosyalar varsa hata vermemesi için önce "gecici_" önekiyle adlandır.
For i = 1 To dosyaSayisi
yeniIsim = masaustuYolu & "\gecici_isim_" & i & ".html"
If objFSO.FileExists(yeniIsim) Then Kill yeniIsim ' Eğer eskiden kalma geçici dosya varsa sil
Name dosyaListesi(1, i) As yeniIsim
dosyaListesi(1, i) = yeniIsim ' Yeni yolu diziye kaydet
Next i

' ÇAKIŞMA ÖNLEME 2. AŞAMA:
' Geçici adlandırılan dosyaları nihai 1.html, 2.html formatına çevir.
For i = 1 To dosyaSayisi
yeniIsim = masaustuYolu & "\" & i & ".html"
If objFSO.FileExists(yeniIsim) Then Kill yeniIsim ' Önlem amaçlı temizlik
Name dosyaListesi(1, i) As yeniIsim
Next i

MsgBox dosyaSayisi & " adet HTML dosyasının ismi indirme sırasına göre başarıyla değiştirildi!", vbInformation, "İşlem Tamamlandı"

' Hafızayı temizle
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub

Hocam emeğinize sağlık, yalnız benim aldığım ekran görüntüsü. Ve PNG, JPG ya da JPEG dosyası. Yine de çalışır mı?