Soru Dosya adını +1 arttırmak

Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Merhaba arkadaşlar;

Şöyle bir sorum vardı, Yardımcı olabilirseniz.
---------------------------------------------------

C:\örnek klasörü içinde deneme.txt isminde bir dosya oluşturuyorum. kod ile... kodu ikinci kez veya daha fazla çalıştırdığımda,;

deneme.txt

deneme1.txt
deneme2.txt
deneme3.txt
deneme4.txt

.....

şeklinde olması için kodda ne gibi ekleme yapmalıyım.

yardımcı arkadaşa şimdiden Teşekkürler.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Oluşturduğunuz kodları ekleyin, ilgilenen arkadaşlar kodlar üzerinde değişiklik yaparlar.
 
Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Necdet;

Kod:
Dim kls, n, DosyaAdi
Dim fs1 As Object
Set fs1 = CreateObject("Scripting.FileSystemObject")
pano.panotxt = Clipboard.GetText
DosyaAdi = deneme
If DosyaAdi = "" Then
MsgBox "İşlem iptal edildi.", , "Klasöre Txt Oluştur"
Exit Sub
End If
komut_txt = pano.panotxt
txtdosya = (CurDir & "\" & DosyaAdi & ".txt")
If Len(Dir(txtdosya)) > 1 Then Kill txtdosya
Open txtdosya For Output As 1
Print #1, komut_txt
Close
 
Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Kontrol ediniz.


Kod:
Dim kls, n, DosyaAdi
Dim fs1 As Object
Dim Clipboard As New MSForms.DataObject
'Asri Akdeniz - asriakdeniz@gmail.com - www.asriakdeniz.com

VBA references de Microsoft Forms 2.0 Object library seçili olmalı.

Sub cokludosya()
    Set fs1 = CreateObject("Scripting.FileSystemObject")
    Clipboard.GetFromClipboard
    panotxt = Clipboard.GetText()
    
    DosyaAdi = "Deneme"
    
    If DosyaAdi = "" Then
        MsgBox "İşlem iptal edildi.", , "Klasöre Txt Oluştur"
        Exit Sub
    End If

    i = 0
    dosya = CurDir & "\" & DosyaAdi & ".txt"
    Do While dosyavarmi(dosya)
       i = i + 1
       dosya = CurDir & "\" & DosyaAdi & i & ".txt"
    Loop
    
    Open dosya For Output As 1
    Print #1, panotxt
    Close

End Sub

Function dosyavarmi(dosya)
  Dim ds, a
  Set ds = CreateObject("Scripting.FileSystemObject")
  a = ds.FileExists(dosya)
  If a = True Then
    dosyavarmi = True
  Else
    dosyavarmi = False
  End If
End Function
 
Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Hocam çok Teşekkür ederim Tamamdır... elinize sağlık.
 
Üst