Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Textboxlarda Görünen Yüklü Dosyaları Winrar İle Sıkıştırarak Tek Textboxta Gösterme

hayalibey
hayalibey
Excel Soruları ve Cevapları
0
538

Textboxlarda Görünen Yüklü Dosyaları Winrar İle Sıkıştırarak Tek Textboxta Gösterme

Thumbs Up #1
hayalibey
Aktif Üye
hayalibey
Bul
Aktif Üye
Adı Soyadı:
Konum:
Ofis Versiyonu:
Son Oturumu: 18/04/2021,04:02
Yorumları: 211
Konuları: 25
Kayıt Tarihi: 30/01/2013
Rep Puanı: 0
Bu kodla sicil yazıp txtboxtan çıktıktan sonra toplu rar dosyası oluşuyor
Kod:
Kod 
Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call rar_hazırla
End Sub

rar_hazirla bu makro ben çalışıyor bazen çalışmıyor
Kod:
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 Sub

mail gönderildikten sonra da bu kod çalışıyor ama sadece textbix21 için textbox 22 de dosya varsa onu da alması lazım ama almıyor
Kod:
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 Sub

rar hazırla makrosu ile textbox21 e oluşan dosyayı aç kodu ile açtığında dosya yolunda dosya olmadığı için için açmıyor. Diğer hatalar
[b][b]cr.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.[/b][/b]

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
.rar Pasif İşlemleri.rar (Dosya Boyutu: 38,19 KB | İndirme Sayısı: 5)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da