iki farkli yerde exel dosyasinin kayit edilmesi hk.

[zetkatamet]

Arkadaslar,
Server uzerinden 4 arkadas yaklasik 10 adet exel dosyasini paylasiyoruz. Butun degisiklikleri ben yapmaktayim. Bu 10 dosya aynen bilgisayarimin hard diskindede mevcut. Degisiklikleri once kendi bilgisayarimda yapiyorum sonra hepsini ortak klasore kopyaliyorum. Yedekli calismis oluyorum.
Sorum su; kendi hard diskimde calistigim exel dosyasini kayit ettigim zaman ortak klasordede ayni dosya kayit edilebilir mi? Amacim hergun dosyalari kopyalamaktan kurtulmak. Cevaplar icin tesekkurler..

 

[halit3]

Arkadaslar,
Server uzerinden 4 arkadas yaklasik 10 adet exel dosyasini paylasiyoruz. Butun degisiklikleri ben yapmaktayim. Bu 10 dosya aynen bilgisayarimin hard diskindede mevcut. Degisiklikleri once kendi bilgisayarimda yapiyorum sonra hepsini ortak klasore kopyaliyorum. Yedekli calismis oluyorum.
Sorum su; kendi hard diskimde calistigim exel dosyasini kayit ettigim zaman ortak klasordede ayni dosya kayit edilebilir mi? Amacim hergun dosyalari kopyalamaktan kurtulmak. Cevaplar icin tesekkurler..

bu kodu denermisiniz.

Sub farklı_kayıtet()
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
kaynak = Klasor.items.Item.Path
If Len(kaynak) = 3 Then
kaynak = Mid(kaynak, 1, 2)
Else
kaynak = kaynak
End If
ad = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
If Not Klasor Is Nothing Then
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
deger = InputBox("UYARI!" & Chr(10) & _
Chr(10) & "  Yeni Dosyanın adını yazınız " & Chr(10) & Chr(10) & _
"", _
"DİKKAT !", ad, , , "DEMO.HLP", 10)
kayıt = MsgBox(deger & " olarak Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = kaynak & "\" & deger & ".xls"
On Error Resume Next
If deger <> "" Then
DosyaSistemi.CopyFile Dosya, kayıt_yeri
Else
MsgBox "DOSYA ADI YAZILI DEĞİL"
End If
End If
ActiveWindow.WindowState = xlMaximized
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[zetkatamet]

Sn.Halit3 ilginize tesekkurler. Kodlar konusunda biraz acemiyim, kendi hard diskimdeki yolu yazdim, kod bolumune yazip exel sayfasina gectigimde ve exel e birsey yazip kaydet dedigimde uyari penceresi cikmakta "Asagidaki ozellikler makro icermeyen calisma kitaplarina kaydedilemez"
Umarim sorum cok baslangic sorusu gibi olmamistir. Saygilar..


Sub farklı_kayıtet()
On Error Resume Next
Dim Baslik As String
Baslik = "C:\Documents and Settings\uerdonmez\Desktop\Umut ERDÖNMEZ\İş_Takip"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
kaynak = Klasor.items.Item.Path
If Len(kaynak) = 3 Then
kaynak = Mid(kaynak, 1, 2)
Else
kaynak = kaynak
End If
ad = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
If Not Klasor Is Nothing Then
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
deger = InputBox("UYARI!" & Chr(10) & _
Chr(10) & " Yeni Dosyanın adını yazınız " & Chr(10) & Chr(10) & _
"", _
"DİKKAT !", ad, , , "DEMO.HLP", 10)
kayıt = MsgBox(deger & " olarak Farklı kayıt etmek istiyormusunuz. ?", vbYesNo)
If kayıt = vbYes Then
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = kaynak & "\" & deger & ".xls"
On Error Resume Next
If deger <> "" Then
DosyaSistemi.CopyFile Dosya, kayıt_yeri
Else
MsgBox "DOSYA ADI YAZILI DEĞİL"
End If
End If
ActiveWindow.WindowState = xlMaximized
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub__________________

 

[halit3]

bu kodu denermisiniz.

Sub farklı_kayıtet()
kaynak = "C:\Documents and Settings\uerdonmez\Desktop\Umut ERDÖNMEZ\İş_Takip"
deger = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = kaynak & "\" & deger & ".xls"
On Error Resume Next
DosyaSistemi.CopyFile Dosya, kayıt_yeri
MsgBox "İşlem tamam"
End Sub

 

[zetkatamet]

tekrar tesekkur ederim sn.halit3, iyi calismalar. Saygilar.

 

[zetkatamet]

Belki faydalanacak bir arkadas olur, ayni anda iki bilgisayarda (ornegin laptop ile isyeri bilgisayari) vs. guncellemeleri icin windows evrak cantasi mukemmel bir cozum. Bende yeni ogrendim paylasayim dedim. Evrak cantasinin bu ise yaradigini bilmezdim

http://support.microsoft.com/kb/307885/tr

 

[halit3]

Belki faydalanacak bir arkadas olur, ayni anda iki bilgisayarda (ornegin laptop ile isyeri bilgisayari) vs. guncellemeleri icin windows evrak cantasi mukemmel bir cozum. Bende yeni ogrendim paylasayim dedim. Evrak cantasinin bu ise yaradigini bilmezdim

http://support.microsoft.com/kb/307885/tr

sayın zetkatamet

güzel bir paylaşım bunu ayrı bir konu açmak yerinde olur zannedersem konuyu siz açın eğer açmıyacaksanız ben açayım

Evrak çantası diye bir başlık

 

[zetkatamet]

Sn.Halit3,
Konuyu siz acin, biraz daha detaylandirirsiniz. Evrak cantasinin halen etkisindeyim, super pratik birsey. Server a bagli ortak klasorde calisma yaptim, kendi bilgisyarimda evrak cantasini guncelle dedigimde yine calisiyor. Iki tarafli guncelemede mevcut. Forum mudavimleri faydalanmali. Saygilar..

 

[halit3]

Sn.Halit3,
Konuyu siz acin, biraz daha detaylandirirsiniz. Evrak cantasinin halen etkisindeyim, super pratik birsey. Server a bagli ortak klasorde calisma yaptim, kendi bilgisyarimda evrak cantasini guncelle dedigimde yine calisiyor. Iki tarafli guncelemede mevcut. Forum mudavimleri faydalanmali. Saygilar..

aşağıdaki linkte konu başlığı Evrak çantası olarak yeni bir konu açtım

http://www.excel.web.tr/showthread.php?t=75660