[Çözüldü] WinRar Dosyası Oluşturma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

[Çözüldü] WinRar Dosyası Oluşturma

İleti#1)  engince » 18 Kas 2010 23:23

Merhaba arkadaşlar,

Aşağıda yazan makro ile oluşturduğum "excel" dosyasını aynı zamanda "rar" dosyası yapıp aynı klasörün içine atmasını istiyorum. Yardımcı olursanız sevinirim.


Kod: Tümünü seç
Sub yeni()

r = "00 00 - 08 00"
d = Day(Worksheets(r).Cells(4, 1).Value)
m = Month(Worksheets(r).Cells(4, 1).Value)
Y = Year(Worksheets(r).Cells(4, 1).Value)
da$ = d
ma$ = m
ya$ = Y
g = da + "." + ma + "." + ya + "-" + "1" + " Bozulma anları" + "." + "xls"


Select Case Month(Worksheets(r).Cells(4, 1).Value)
Case 1
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\OCAK"
Case 2
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\ŞUBAT"
Case 3
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\MART"
Case 4
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\NİSAN"
Case 5
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\MAYIS"
Case 6
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\HAZİRAN"
Case 7
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\TEMMUZ"
Case 8
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\AĞUSTOS"
Case 9
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\EYLÜL"
Case 10
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\EKİM"
Case 11
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\KASIM"
Case 12
Z = "C:\Documents and Settings\kaan\Desktop\Yeni Klasör\2010\ARALIK"

End Select

ChDir _
(Z)
    Workbooks.Open Filename:=Z & "\" & "GUNLUKRAPOR.xls"
    'Workbooks.Open Filename:=
    '"GUNLUKRAPOR.xls"
    Cells.Select
    Selection.Copy
    Windows("Uretim.xls").Activate
    Range("A3:C117").Select
    Selection.Copy
    Windows("GUNLUKRAPOR.xls").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("B18").Select
   
        Application.CutCopyMode = False
    'ActiveWorkbook.SaveAs Filename:= _
        '(g) _
        ', FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        'ReadOnlyRecommended:=False, CreateBackup:=False

'Windows(g).Activate
   
    P$ = Z + "\" + g
    ActiveWorkbook.SaveAs Filename:= _
        (P), FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

ActiveWorkbook.Close

End Sub
Kullanıcı avatarı
engince
Yeni Başlamış
 
Adı Soyadı:kaan ekol
Kayıt: 16 Ağu 2010 19:09
Konum: ordu
Meslek: diğer
Yaş: 38
İleti: 22
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: çanakkale

Cevap: WinRar dosyası oluşturma

İleti#2)  Tarkan VURAL » 22 Kas 2010 17:15

Gerçi Temel bey size yardımcı olmuş ama bir alternatif daha olsun. ;)
Excel ile Mail İşlemleri başlığında, Winrar yaparak mail gönderme örneğimizden alınmıştır.


Kod: Tümünü seç
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal IslemNo As Long, lpExitCode As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Sub Winrar_Yap_Mail_Yolla()
Dim DosKomut As String, TarihMetin$, RarDosyaAdi$, XlsDosyaAdi$
Dim ProgramNo As Long, IslemNo As Long, ExitCode As Long

If Dir("C:\Program Files\WinRAR\rar.EXE") <> "" Then
       
        TarihMetin = Format(Now, "ddmmyyyyhhmm")
        rardosyayolu = ActiveWorkbook.Path & "\"
        RarDosyaAdi = rardosyayolu & ActiveWorkbook.Name & "_" & TarihMetin & ".rar"
        XlsDosyaAdi = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "_" & TarihMetin & ".xls"
       
        ActiveWorkbook.SaveCopyAs Filename:=XlsDosyaAdi
        DosKomut = "C:\Program Files\winrar\rar a" & " " & Chr(34) & RarDosyaAdi & Chr(34) & " " & Chr(34) & XlsDosyaAdi & Chr(34)
        ProgramNo = Shell(DosKomut, 1)
        IslemNo = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProgramNo)
       
        Do
            GetExitCodeProcess IslemNo, ExitCode
        DoEvents
        Loop While ExitCode = STILL_ACTIVE
       
        Kill XlsDosyaAdi
End If
    rardosyayolu = vbNullString
    XlsDosyaAdi = vbNullString: ProgramNo = Empty: IslemNo = Empty:
    DosKomut = vbNullString: TarihMetin = vbNullString: RarDosyaAdi = vbNullString
End Sub
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26788
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

Cevap: WinRar dosyası oluşturma

İleti#3)  Murat OSMA » 22 Kas 2010 20:03

En kısa yolu sanırım bu şekilde olacaktır.
Thisworkbook.Path yerine hedef dosyanızın yolunu yazın.


Aşağıdaki kodda, sıkıştırılmak istenen Excel (.xls) dökümanının ismini belirterek, belirlediğiniz yolda şıkıştırılmış olarak görüntüleyebilirsiniz.
Kod: Tümünü seç
Sub EVN()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a KESİM2.murat KESİM2.XLS", vbHide
End Sub


Aşağıdaki kodda ise, belirlediğiniz yoldaki tüm Excel (.xls) dökümanlarını evn.rar olarak şıkıştırıp belirlediğiniz yolda görüntüleyebilirsiniz.
Kod: Tümünü seç
Sub EVN()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a evn.rar *.XLS", vbHide
End Sub


Hoşça kalın !!! ;;_)
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 05 Arl 2008 00:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 33
İleti: 14306
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

Cevap: WinRar dosyası oluşturma

İleti#4)  Tarkan VURAL » 22 Kas 2010 20:09

Gerçekten çok kısa olmuş. :)
şkşk
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26788
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: WinRar dosyası oluşturma

İleti#5)  engince » 26 Kas 2010 17:18

Çok teşekkürler arkadaşlar ... şkşk
Kullanıcı avatarı
engince
Yeni Başlamış
 
Adı Soyadı:kaan ekol
Kayıt: 16 Ağu 2010 19:09
Konum: ordu
Meslek: diğer
Yaş: 38
İleti: 22
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: çanakkale

Cevap: WinRar dosyası oluşturma

İleti#6)  Murat OSMA » 23 Mar 2011 12:00

Rica ederiz Kaan bey.
İyi akşamlar.
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 05 Arl 2008 00:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 33
İleti: 14306
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: WinRar Dosyası Oluşturma

İleti#7)  Murat OSMA » 17 Mar 2012 14:35

WirRar ile Dosya Arşivleme konusunda, komut ve anahtar listesi şu şekildedir;

Alfabetik Komut Listesi
aArşive dosyalar ekle
cArşiv açıklaması ekle
chArşiv parametrelerini değiştir
cvArşivleri dönüştür
cwDosyaya arşiv açıklaması yaz
dArşivden dosyalar sil
eKlasörleri yoksayarak arşivden dosya çıkart
fArşivdeki dosyaları tazele
iArşiv içerisinde sözdizimi bul
kArşivi kilitle
mDosyaları ve klasörleri arşive taşı
rHasarlı bir arşivi onar
rcEksik ciltleri tekrar yapılandır
rnArşivlenmiş dosyaları yeniden adlandır
rrKurtarma kaydı ekle
rvKurtarma ciltleri oluştur
s[isim]Arşivi kendi-açılan türe dönüştür
s-SFX modülünü sil
tArşiv dosyalarını test et
uArşivdeki dosyaları güncelle
xArşivden tam klasör adıyla çıkart


Alfabetik Anahtar Listesi
-acSıkıştırdıktan veya çıkarttıktan sonra Arşiv öznit
-adArşiv adını hedef klasöre ekle
-af<tür>Arşiv biçimini belirle
-ag[biçim]Şu anki tarih ve saate göre arşiv adı oluştur
-aiDosya özniteliklerini yoksay
-aoArşiv özniteliği olan dosyaları ekle
-ap<yol>Arşiv içerisindeki klasörü ayarla
-asArşiv içeriğini eşitle
-avGerçeklik denetleme uygula
-cfg-Varsayılan profili ve ortam değişkenini yoksay
-av-Gerçeklik denetleme eklemeyi devre dışı bırak
-clDosya isimlerini küçük harfe dönüştür
-cp<isim>Sıkıştırma profilini seç
-cuDosya isimlerini büyük harfe dönüştür
-dfArşivledikten sonra dosyaları sil
-dhPaylaşılmış dosyaları aç
-drSilinen dosyaları Geri Dönüşüm Kutusuna taşı
-dsArşivlenen dosyalara sıralama yapma
-dwDosyaları arşivledikten sonra temizle
-e[+]<öznt>Dosya dışlama ve dahil etme özniteliklerini ayarla
-edBoş klasörleri ekleme
-en"arşiv sonu" bloğunu ekleme
-epYolları isimlerden dışla
-ep1Esas yolu isimlerden dışla
-ep2Yolları tam genişlet
-ep3Sürücü harfiyle yolları tam genişlet
-fDosyaları tazele
-hp[parola]Dosya ve veri üstbilgilerini şifrele
-ibckSFX arşivi için yönetimsel erişim iste
-ibckWinRAR'ı arka planda çalıştır
-ieml[.][adres]Arşivi eposta ile gönder
-iicon<isim>SFX simgesi belirt
iimg<isim>SFX logosu seç
-ilog[isim]Hataları günlüğe kaydet
-inulHata mesajlarını devre dışı bırak
-ioffBilgisayarı kapat
-kArşivi kilitle
-kbBozuk çıkartılan arşivleri koru
-m<n>Sıkıştırma yöntemini ayarla
-mc<par>Gelişmiş sıkıştırma parametrelerini ayarla
-md<n>Sözlük boyutunu ayarla
-ms[liste]Depolanacak dosya türlerini seç
-mt<threads>Thread sayısını ayarla
-n<dosya>Sadece belirtilen dosyayı dahil et
n@<liste_dosyası>Dosyaları, belirtilen liste dosyasını kullanarak d
-ocNTFS “Sıkıştırılmış” özniteliğini aç
-orDosya adlarını otomatik olarak değiştir
-osNTFS akımlarını kaydet
-owDosya güvenlik bilgisini işle
-o[+|-]Üzerine yazma modunu ayarla
-p[parola]Parolayı ayarla
-rAlt klasörleri içer
-r-Alt klasörleri içermeyi devre dışı bırak
-r0Alt klasörleri sadece joker adları için içer
-riÖnceliği ve bekleme süresini ayarla
-rrVeri kurtarma kaydı ekle
-rvKurtarma ciltleri oluştur
-sKatı arşiv oluştur
-s<N>Dosya sayısına göre katı gruplar oluştur
-sc<karakterseti>[nesneler]Karakter setini belirt
-seDosya uzantısına göre katı gruplar oluştur
-sfx[isim]Kendi-açılan arşiv oluştur
-sl<boyut>Belirtilen boyuttan daha küçük dosyaları işle
-sm<boyut>Belirtilen boyuttan daha büyük dosyaları işle
-svSerbest katı ciltler oluştur
-sv-Bağımlı katı arşivler oluştur
-s-Katı arşivlemeyi devre dışı bırak
-tArşivledikten sonra dosyaları test et
-ta<tarih>Belirlenen tarihten sonra değişen dosyaları ekle
-tb<tarih>Belirlenen tarihten önce değişen dosyaları ekle
-tkOrijinal arşiv tarihini koru
-tlArşiv tarihini en yeni dosyanın tarihine ayarla
-tn<zaman>Belirlenen zamandan yeni olan dosyaları işle
-to<zaman>Belirlenen zamandan eski olan dosyaları işle
-ts<m,c,a>Dosya zamanını kaydet veya geri yükle (değişme, ol
-uDosyaları güncelle
-v<n>[k|b|f|m|M]Ciltler oluştur
-vdCilt oluşturmadan önce disk içeriğini sil
-verDosya sürümü kontrolü
-vnEski stil cilt adlandırma planını kullan
-vpHer ciltten önce duraklat
-x<dosya>Belirlenen dosyayı dışla
-x@<liste_dosyası>Liste dosyasında listelenen dosyaları dışla
-yTüm sorulara Evet cevabı verildiğini varsayılsın
-z<dosya>Dosyadan arşiv açıklaması oku
--Anahtar taramasını durdur.


Kullanım Örnekleri;

* Evn.xls kitabı sıkıştırıp, parolasını "Emre" yapmak için;
Kod: Tümünü seç
Sub Evn()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a -p[Emre]  Evn.rar  Evn.xls", vbHide
End Sub

* Evn.xls kitabını sıkışıtırp, açıklama olarakta Bilgi.txt'yi eklemek için;
Kod: Tümünü seç
Sub Evn()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a -zBilgi.txt  Evn.rar Evn.xls", vbHide
End Sub

* Evn.xls kitabını parçalara ayırarak (98 KB'lik ciltler oluşturarak) sıkıştırmak için;
Kod: Tümünü seç
Sub Evn()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a -v100 Evn.rar Evn.xls", vbHide
End Sub
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 05 Arl 2008 00:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 33
İleti: 14306
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

Cevap: Cevap: WinRar dosyası oluşturma

İleti#8)  dnmtnk » 11 Ekm 2018 12:22

Murat OSMA yazdı:En kısa yolu sanırım bu şekilde olacaktır.
Thisworkbook.Path yerine hedef dosyanızın yolunu yazın.


Aşağıdaki kodda, sıkıştırılmak istenen Excel (.xls) dökümanının ismini belirterek, belirlediğiniz yolda şıkıştırılmış olarak görüntüleyebilirsiniz.
Kod: Tümünü seç
Sub EVN()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a KESİM2.murat KESİM2.XLS", vbHide
End Sub


Aşağıdaki kodda ise, belirlediğiniz yoldaki tüm Excel (.xls) dökümanlarını evn.rar olarak şıkıştırıp belirlediğiniz yolda görüntüleyebilirsiniz.
Kod: Tümünü seç
Sub EVN()
ChDir ThisWorkbook.Path
VBA.Shell "C:\PROGRAM FILES\WINRAR\rar.exe a evn.rar *.XLS", vbHide
End Sub


Hoşça kalın !!! ;;_)


Merhabalar Murat Bey,
eski bir konuyu güncellemiş olacağım ama bu vermiş olduğunuz kodu excel 2016'da denediğimde rar dosyası oluşturmadı.
Kod gayet kısa ve anlaşılır. Dosya yolunu ve dosya adını direk vererekte denememe rağmen rar oluşturamadım. Acaba 2016 versiyonda farklı bir düzenleme yapmak gerekir mi? Bu konuda yardımcı olabilir misiniz rica etsem?
Kullanıcı avatarı
dnmtnk
Yeni Başlamış
 
Kayıt: 25 Kas 2014 15:07
Meslek: Bilgi işlem
Yaş: 33
İleti: 36
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

Cevap: [Çözüldü] WinRar Dosyası Oluşturma

İleti#9)  Tarkan VURAL » 11 Ekm 2018 15:14

Merhaba,

Kod: Tümünü seç
Sub RarYap()
ChDir ThisWorkbook.Path
XlsDosyaAdi = "NOVULAS ANKARA.XLS"
RarDosyaAdi = "BuralaaCokKalaba.rar"
s = "C:\Program Files\winrar\rar a" & " " & Chr(34) & RarDosyaAdi & _
Chr(34) & " " & Chr(34) & XlsDosyaAdi & Chr(34)
Shell s, vbHide
End Sub
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 45
İleti: 26788
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Bing[Bot] ve 2 misafir

cron
Bumerang - Yazarkafe