Hata ve Çözümü

[hlojan]

' SERTİFİKA  ADI
SV1 = Worksheets("Veri").Range("AI6").Value
' SERTİFİKA KLASÖRÜ
SV2 = Worksheets("Veri").Range("AI6").Value
'  FİRMA KLASÖRÜ
SV3 = Worksheets("Veri").Range("AL122").Value

' ARŞİV TARİH KLASÖRÜ
SV4 = Format(Date, "dd.mm.yy")
' HANGİ AY KLASÖRÜ
SV5 = Worksheets("Veri").Range("AJ134").Value



ad1 = "C:\ARŞİV\" & SV4

If CreateObject("Scripting.FileSystemObject").FolderExists(ad1) = False Then
MkDir ad1
End If

ad2 = "C:\ARŞİV\" & SV4 & "\" & SV3

If CreateObject("Scripting.FileSystemObject").FolderExists(ad2) = False Then
MkDir ad2
End If

ad3 = "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2

If CreateObject("Scripting.FileSystemObject").FolderExists(ad3) = False Then
MkDir ad3
End If

 
ad4 = "A:\" & SV5

If CreateObject("Scripting.FileSystemObject").FolderExists(ad4) = False Then
MkDir ad4
End If

ad5 = "A:\" & SV5 & "\" & SV3

If CreateObject("Scripting.FileSystemObject").FolderExists(ad5) = False Then
MkDir ad5
End If

ad6 = "A:\" & SV5 & "\" & SV3 & "\" & SV2

If CreateObject("Scripting.FileSystemObject").FolderExists(ad6) = False Then
MkDir ad6
End If

With ActiveDocument
.SaveAs "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
.SaveAs "A:\" & SV5 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
End With
MsgBox "WORD KAYDEDİLDİ", vbInformation, "Metro"

Dim objWord As Object
    
    Set objWord = GetObject(, "Word.Application")
    
    objWord.Quit False
With ActiveWorkbook
.SaveCopyAs "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".xls"
.SaveCopyAs "A:\" & SV5 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".xls"
 On Error Resume Next
End With
MsgBox "EXCEL KOPYASI KAYDEDİLDİ", vbInformation, "Metro"
' **********************************************************


' ****************************************

CommandButton3.Enabled = False
CommandButton3.BackColor = RGB(255, 255, 255)

CommandButton3.Caption = Worksheets("Veri").Range("Aı6").Value & " Kaydedildi"
CommandButton3.Font.Size = 10

Hatayı Debug Yaptığımda

[COLOR="Red"][U]With ActiveDocument[/U][/COLOR].SaveAs "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
.SaveAs "A:\" & SV5 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
End With

burda gösteriyor.

End Deyip tekrar kodu çalıştırırsam çalışıo

Ama Herdefasında end diyip tekrar yapmak işimi zorlaştırıyor.

Yardımlarınızı bekliyorum

 

[Necdet]

Merhaba,

.SaveAs "A:\" & SV5 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"


satırında A sürücüsünün olmadığından hata veriyor. A sürücüsü disket sürücüsüdür, şimdi öyle bir şey kaldığını sanmıyorum.

O satırı silin derim.

ilk gördüğümü yazdım.

 

[hlojan]

A: sürücüsü ağ sürücü

Ağ kısayolunu kısalttım

With ActiveDocument ile alakalı bir sorun varda

çünkü 1 kere bastığımda hata veriyor. End yapıp makroyu sonlandırıp 2. kez çalıştırdığımda çalışıyor.

Büyük ihtimal With ActiveDocument göremiyor. ilk yaptığımda

Yada bana şöyle bir çözümde işimi görür.

Çıkan hata gözükmesin. Benim oluşturduğum msgbox gözüksün

Çıkan hata komutundaki "End" butonu komutunuda bilmem gerek bunu yapmak için

Makroyu sonlandırmak için

 

[Emir Hüseyin Çoban]

. . .

[B]on error resume next[/B]
With ActiveDocument.SaveAs "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
.SaveAs "A:\" & SV5 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
End With
[B]on error goto 0[/B]

. . .

 

[halit3]

O bölümdeki word dosyası varmı word dosyası olmadığından alıyorsunuz o hatayı halbüki bir alt satırda word ile ilgili objeyi tanımlamışsınız.

böyle

dosya = "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set wrdDoc = objWord.documents.Open(dosya)
With wrdDoc
.SaveAs (dosya)
.Close
End With
objWord.Quit
Set wrdDoc = Nothing
Set objWord = Nothing

veya böyle deneyiniz.

dosya = "C:\ARŞİV\" & SV4 & "\" & SV3 & "\" & SV2 & "\" & SV1 & ".doc"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set MyDoc = objWord.documents.Add(DocumentType:=wdNewBlankDocument)

objWord.ActiveDocument.SaveAs (dosya)
objWord.ActiveDocument.Close
objWord.Quit

 

[hlojan]

Teşekkürler Halit ve Hüseyin Bey