Kod:
Kod:
Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call rar_hazırla
End SubKod:
Kod:
Sub rar_hazırla()
Dim yol As String, tx As Variant, a As Long, dosyalar As String
yol = Sheets("SABİTLER").[B1].Text
If Dir(yol & "\TOPLU.rar", vbDirectory) <> "" Then Kill yol & "\TOPLU.rar" '<----------------<<-'
TextBox21 = ""
tx = Array("8", "9", "10", "11", "12", "13")
For a = 0 To UBound(tx)
If Me.Controls("TextBox" & tx(a)) <> "" And Dir(Me.Controls("TextBox" & tx(a)), vbDirectory) <> "" Then
If dosyalar <> "" Then m = " "
dosyalar = dosyalar & m & Dir(Me.Controls("TextBox" & tx(a)), vbDirectory)
End If
Next
ChDir yol
If dosyalar <> "" Then
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a TOPLU.rar " & dosyalar, vbHide
TextBox21 = yol & "\TOPLU.rar"
Else
MsgBox "Dosya bulunamadı"
End If
End SubKod:
Kod:
Sub kayıt()
sor = MsgBox("Gönderilen dosyalar kaydedilsinmi?", vbYesNo)
If sor = vbYes Then
Dim ad As String, yeniad1 As String, yeniad2 As String, adres As String, cr As Object
adres = Sheets("SABİTLER").[B3].Text & "\"
If Dir(adres, vbDirectory) = "" Then
MkDir adres
adres = adres & "\"
Application.Wait (Now + TimeValue("0:00:02"))
End If
Set cr = CreateObject("scripting.filesystemobject")
If TextBox22.Text <> "" And Dir(TextBox22, vbDirectory) <> "" Then
ad = Replace(cr.GetBaseName(TextBox22.Text) & "_" & Replace(Now, " ", "_"), ":", ".")
'yeniad2 = Replace(TextBox22.Text, cr.GetBaseName(TextBox22.Text), ad)
cr.CopyFile Source:=TextBox22.Text, Destination:=adres
Name adres & cr.GetBaseName(TextBox22.Text) & "." & cr.GetExtensionName(TextBox22.Text) As adres & ad & "." & cr.GetExtensionName(TextBox22.Text)
End If
If TextBox21.Text <> "" And Dir(TextBox21, vbDirectory) <> "" Then
ad = Replace(cr.GetBaseName(TextBox21.Text) & "_" & Replace(Now, " ", "_"), ":", ".")
yeniad1 = Replace(TextBox21.Text, cr.GetBaseName(TextBox21.Text), ad)
Name TextBox21.Text As yeniad1
cr.moveFile Source:=yeniad1, Destination:=adres
End If
MsgBox cr.GetBaseName(TextBox22.Text) & " Dosyası Dosyanızın yanındaki KLASOR e YEDEKLENDİ" & vbCrLf & _
cr.GetBaseName(TextBox21.Text) & " Dosyası Dosyanızın yanındaki KLASOR e TAŞINDI"
Else
If Dir(TextBox21, vbDirectory) <> "" Then Kill TextBox21.Text
End If
End Subcr.moveFile Source:=yeniad1, Destination:=adres bu satırda hata veriyor.
Rar hazırla kodu sabitler sayfasının b2 satırından yolunu alsa . Rar hazırla makrosu textbox21e geliyir ama yolu acinca dosya olmadigondan calışmıyor . Bazen çalışıyor eski toplu.rar dosyası hep geliyor onun için rar hazırla dosya kaydedecehi konumdaki varsa toplu rar dosyasini silecek sonra sabitler b2 deki yoldaki yere yeni toplu rar dosyasini atacak . Daha sonra kayit makrosu ile toplu rar dosyasi ve vaesa textbox22 de dosyayi tarih saaat sicil toplu rar dosyalarıni ise tarih_saat_txtsicili_Toplu ismi ile sabitler sayfasının b3 hücresindeki adrese kaydetmesini istiyorum . Size bendeki userformu gönderiyorum.
Windows 10 yaptım ofisi sildim ofis 2016 Tr 64 biti yeniden yükledim ama sorunum çözülmedi.
Sizden istirham ediyorum tekrar bakma imkanınız var mı koda bu durumda kodu kullanamıyorum.
rar_hazırla Sub () makrosu Textbox21 e rar hazırlıyor tamam ama bu rar hazırla toplu rar dosyasını Sabitler b1 hücresindeki adrese kaydetmediği sürece textbox21 2de sadece yolda olduğu görünüyor Aç komutuyla açmaya çalışıyorum Dosyayı açmıyor çünkü Sabitler sayfası B1 hücresindeki yola atmıyor Toplu Rar dosyasını . Atmadığı için gönderirken toplu ek yok diye uyarı da veriyor.
- 1. Sizden istirhamım Sabitler sayfası B1 hücresindeki yolda toplu rar dosyası varsa bunu ilkin silsin mutlaka sonra yeniden toplu rar oluştursun / kaydetsin Sabitler sayfası B1 hücresindeki yola.
- 2. Rar hazırla makrosundaki yolu Textbok14_Exıt komutu ile getirebiliyorum Textbox21 e.
- 3. Mail gönder dediğimde textbox21 ve eğer varsa textbox22 deki dosyaları mail attıktan sonra kayıt Sub () makrosu ,ile Sabitler Sayfası B3 deki yola yoksa eğer EKLER isimli klasör açsın EKLER klasörü varsa içine tarih_saat_txtsicili_TOPLU.rar şeklinde ve yine Textbok22 de de dosya olması durumunda tarih_saat_txtsicili_ve dosya adı neyse şeklinde olması durumunda textbox21 ve Textbox22 de olan dosyaları mutlaka kaydetsin.
Kayıt Sub () makrosu bu hali ile sadece Textbox21 deki toplu dosyayı Sabitler Sayfası B3 deki yola KLASÖR dosyasına atıyor TEXtbox22 ye hiç bakmıyor bile
