Kod birleştirme

[ASLAN7410]

Merhaba, hayırlı akşamlar.

Aşağıdaki kod excel dosyasını açtığımda otomatik olarak dosyanın yedeğini alıyor.
Dosyanın yedeğini aldığında 14.12.2017 20_07_47 bu şekilde dosyanın adını yazıyor.

Benim yapmak istediğim dosyanın adını bu şekilde yazmasını istiyorum.
14.12.2017 20_07_47 Örnek1 Örnek1 yazan yer dosyanın adı.

Dosyanın adını siyahla belirtmiş olduğum yere eklemeye çalışıyorum hep hata veriyor.

Private Sub Workbook_Open()
If Application.UserName <> "ADMİN" Then
'MsgBox ("Dosyayı yedeklemeyi sadece ADMİN yapabilir,"), vbInformation
Exit Sub
End If

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

DosyaAdi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(DosyaAdi)
[B]yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti[/B]
ds.CopyFile DosyaAdi, yol

End Sub

Dosyanın adını alan kod'da aşağıda.

Sub DosyanınAdı()
DosyaAdi = ThisWorkbook.Name
DosyaUzanti = LCase(Mid(DosyaAdi, InStr(1, DosyaAdi, ".", 1) + 1))
SadeceAd = Mid(DosyaAdi, 1, (Len(DosyaAdi) - Len(DosyaUzanti) - 1))
'MsgBox SadeceAd, vbInformation
End Sub

Yardımcı olur musunuz?

.

 

[AdemCan]

Merhaba,
Dosyanızı indirme imkanım olmadığı için deneyemedim ama ilgili bölümü şu şekilde değiştirip dener misiniz?

DosyaAdi = ThisWorkbook.FullName
[COLOR="Blue"]DosyaUzanti = LCase(Mid(DosyaAdi, InStr(1, DosyaAdi, ".", 1) + 1))
SadeceAd = Mid(DosyaAdi, 1, (Len(DosyaAdi) - Len(DosyaUzanti) - 1))[/COLOR]
uzanti = "." & ds.GetExtensionName(DosyaAdi)
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") [COLOR="Blue"]& " " & SadeceAd[/COLOR] & uzanti
ds.CopyFile DosyaAdi, yol

 

[ASLAN7410]

Sayın faye_efsane ilginiz için çok teşekkür ediyorum.

Sizin yazmış olduğunuz gibi yaptığımda aşağıdaki hata mesajını veriyor.

Run-time error '52':
Bad file name or number

 

[AdemCan]

Merhaba,
Çalışma dosyanızı link olarak paylaşabilir misiniz?
Dosya üzerinden deneme yapayım.

 

[YUSUF44]

Acaba

yol = yer & "[COLOR="Red"]/[/COLOR]" & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti

yerine

yol = yer & "[COLOR="red"]\[/COLOR]" & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti

olur mu?

 

[ASLAN7410]

Sayın Yusuf Bey, ilginiz için çok teşekkür ediyorum.

Sizin dediğiniz gibi de yaptım olmadı. Aşağıdaki hatayı veriyor.

Run-time error '52':
Bad file name or number

Private Sub Workbook_Open()
If Application.UserName <> "ADMİN" Then
'MsgBox ("Dosyayı yedeklemeyi sadece ADMİN yapabilir,"), vbInformation
Exit Sub
End If

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

DosyaAdi = ThisWorkbook.FullName
DosyaUzanti = LCase(Mid(DosyaAdi, InStr(1, DosyaAdi, ".", 1) + 1))
SadeceAd = Mid(DosyaAdi, 1, (Len(DosyaAdi) - Len(DosyaUzanti) - 1))
uzanti = "." & ds.GetExtensionName(DosyaAdi)
yol = yer & "\" & Format(Now, " dd.mm.yyyy hh_nn_ss") & " " & SadeceAd & uzanti
ds.CopyFile DosyaAdi, yol

End Sub

 

[ASLAN7410]

Sayın faye_efsane dosya aşağıdaki linkte.

http://dosya.co/r9w7ifik8fe6/Örnek1.xlsm.html

 

[ASLAN7410]

Arkadaşlar yapmak istediğim dosyayı açtığımda dosya otomatik olarak aşağıdaki gibi kaydetmesini istiyorum.

14.12.2017 20_07_47 Örnek1 Örnek1 yazan yer dosyanın adı.

 

[YUSUF44]

dd.mm.yyyy

yerine

dd mm yyyy

ya da

ddmmyyyy

olur mu?

 

[ASLAN7410]

Olur sayın Yusuf Bey.

 

[YUSUF44]

Muhtemelen bilgisayar ayarlarınızın dosya adında tarih formatlı veri istememesi neden oluyor.

 

[AdemCan]

Merhaba,
İlgili bölümü şu şekilde değiştiriniz.

DosyaAdi = ThisWorkbook.FullName
dosyaadi2 = ThisWorkbook.Name
DosyaUzanti = LCase(Mid(dosyaadi2, InStr(1, dosyaadi2, ".", 1) + 1))
SadeceAd = Mid(dosyaadi2, 1, (Len(dosyaadi2) - Len(DosyaUzanti) - 1))
uzanti = "." & ds.GetExtensionName(DosyaAdi)
yol = yer & "\" & Format(Now, " dd.mm.yyyy hh_nn_ss") & " " & SadeceAd & uzanti
ds.CopyFile DosyaAdi, yol

 

[ASLAN7410]

Sayın Yusuf Bey, aşağıdaki kod tarih, saat, dakika, saniye şeklinde kayıt yapıyor zaten.

Benim yapmak istediğim ayrıca bu kaydın yanına dosyanın adını eklemek.

Private Sub Workbook_Open()
If Application.UserName <> "ADMİN" Then
'MsgBox ("Dosyayı yedeklemeyi sadece ADMİN yapabilir,"), vbInformation
Exit Sub
End If

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

DosyaAdi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(DosyaAdi)
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti
ds.CopyFile DosyaAdi, yol

End Sub

 

[ASLAN7410]

Merhaba,
İlgili bölümü şu şekilde değiştiriniz.

Sayın faye_efsane, çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Hayırlı geceler, hayırlı çalışmalar diliyorum.

 

[AdemCan]

Teşekkürler, Sizede hayırlı geceler, hayırlı çalışmalar.

 

[TanerSaydam]

Attığınız excel'de denedim, ama yer kısmına kendi masaüstümü gösterdiğimde sorunsuz çalıştı. Kastettiğiniz bu sanırım. Bir deneyip bilgi verebilir misiniz?

'If Application.UserName <> "ADMİN" Then
MsgBox ("Dosyayı yedeklemeyi sadece ADMİN yapabilir,"), vbInformation
Exit Sub
End If
Dim ad As Variant

Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

ad = "Örnek1"

DosyaAdi = ThisWorkbook.FullName
DosyaUzanti = LCase(Mid(DosyaAdi, InStr(1, DosyaAdi, ".", 1) + 1))
SadeceAd = Mid(DosyaAdi, 1, (Len(DosyaAdi) - Len(DosyaUzanti) - 1))
uzanti = "." & ds.GetExtensionName(DosyaAdi)
yol = yer & "\" & Format(Now, " dd.mm.yyyy hh_nn_ss") & " " & ad & uzanti
ds.CopyFile DosyaAdi, yol

 

[ASLAN7410]

Sayın Taner Bey, göndermiş olduğunuz kod gayet güzel çalışıyor, ellerinize sağlık.

Ancak dosyanın adı sürekli sabit değil.

 

[TanerSaydam]

Sayın Taner Bey, göndermiş olduğunuz kod gayet güzel çalışıyor, ellerinize sağlık.

Ancak dosyanın adı sürekli sabit değil.

Bunu da düşündüm ama açılışta kaydettiği için değeri hücreye vermedim. Ama isterseniz siz orayı a = Range("A1").Value diyerek A1 hücresine bağlayabilrsiniz.

 

[ASLAN7410]

Sayın Taner Bey çok teşekkür ediyorum.

Hayırlı geceler, hayırlı çalışmalar diliyorum.

 

[TanerSaydam]

Yardımcı olabildiysem ne mutlu bana. İyi çalışmalar dilerim