Makro Bulunamadı Hatası

[kduman]

Herkese iyi akşamlar,
uzun zamandır uğraştığım bir makroyu tamamlamaya çalışıyorum ama bir yerde tıkandım,
özetlemek gerekirse,
excel sayfam günün belirli bir saatinde otomatik olarak açılacak 5 sn sonra belirlediğim adreslere otomatik olarak mail atacak.
mail atma işlemi manuelde sorunsuz işliyor ama otomatik olarak yapmaya çalıştığımda "bu makro bulanamadı veya devre dışı olabilir" tarzı bir uyarı veriyor, tüm güvenlik ayarlarım en düşükte ne yaptıysam olmadı.
ayrıca onu daha sonra yapacağım o da ayrı bir konu günde sadece 1 defa mail gidecek otomatik olarak, exceli her açtığımda mail gitmesini istemiyorum.
formda gördüm çok eski konularda var ama ne dedilerse yaptım olmadı.
yardımlarınızı bekliyorum.
şimdiden teşekkürler iyi çalışmalar diliyorum.

 

[kduman]

Sub Autpen()
Application.OnTime Now + TimeSerial(0, 0, 5), "Ay"
End Sub

Private Function Ay()
Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range

If Cells(2, 2) = "" Then GoTo HATA

On Error GoTo HATA

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

saydir = WorksheetFunction.CountIf(Range("d:d"), "<>") + 1
DinamikAlan = "d2:" & "k" & saydir
Set Alan = Worksheets("Sayfa1").Range(DinamikAlan)

Set Sayfa = ActiveSheet

With Alan

.Parent.Select
Set daralan = ActiveCell

.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope

.Introduction = "Otomatik maildir lütfen cevap vermeyiniz!.. ...... tarafından Tasarlanmıştır"
With .Item
.To = Cells(2, 2)
.CC = Cells(3, 2)
.Subject = Cells(1, 2)
.bcc = ""
.Send
End With

End With

daralan.Select
End With

Sayfa.Select

HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Function

 

[cems]

www.dosya.tc

 

[kduman]

www.dosya.tc

iyi akşamlar,
dosyayı paylaşım yerine yükledim sayın Cems

 

[cems]

iyi akşamlar,
dosyayı paylaşım yerine yükledim sayın Cems

Linki de buraya kopyalamalısınız. Ayrıca

excel sayfam günün belirli bir saatinde otomatik olarak açılacak 5 sn sonra belirlediğim adreslere otomatik olarak mail atacak

Başka bir açık excel dosyası tarafından çağrılmadığı sürece windowsun zamanlanmış görevleri ile dosya açılabilir. Açıldıktan 5 saniye sonrası için de wait kodu gerekli. İkisi ayrı konu ve ilki sizin ile makinanız arasında bir konu, zamanlanmış görevler konusunu irdeleyin .

 

[kduman]

Sayın Cems haklısınız ilki benim bilgisayar ile ilgili onu bir şekilde çözeceğim ama dediğim gibi açıldıktan sonra makroyu çalıştıramadım,
ayrıca günde sadece 1 defa çalışma noktasında da yardımınızı bekliyorum.
şimdiden teşekkür ederim.
dosyanın linki aşağıdadır,

http://s3.dosya.tc/server13/8bvbl5/Makro_Mail.rar.html

 

[askm]

Aşağıdaki şekilde deneyin.

Private Sub workbook_open()
On Error Resume Next
eskitarih = CDate(Range("W1").Value)
If Date <> eskitarih Then Ay
Range("W1").Value = Date
End Sub

Private Function Ay()
    Dim Rky As Object
    yol$ = ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, From:=1, To:=2, OpenAfterPublish:=False
    Set Rky = CreateObject("Outlook.Application").CreateItem(0)
    With Rky
        .To = "askmadige342@hotmail.com" '"kayaduman@gursoygrup.com.tr"
        .CC = ""
        .BCC = ""
        .Subject = "iş prg"
        .Body = "ek"
        .Attachments.Add yol$
        .Send
    End With
    Set Rky = Nothing: yol = ""
End Function

 

[cems]

Private Function Ay()
Dim Rky As Object
yol$ = ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".pdf"
Range("C1:L49").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\KASA\Desktop\s.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Set Rky = CreateObject("Outlook.Application").CreateItem(0)
With Rky
.To = "kayaduman@gursoygrup.com.tr"
.CC = ""
.BCC = ""
.Subject = "iş prg"
.Body = "ek"
.Attachments.Add yol$
.Send
End With
Set Rky = Nothing: yol = ""
End Function

sayfa pdf ye çevrildiğinde alan belirtin ve yolu siz düzeltin , şu an bu kodları deneme şansım yok sadece mantık yürütebildim

 

[kduman]

Sayın Cems günaydın,
kodlar için teşekkürler ilgilenmeniz yeterli,
ben deneyip bilgi vereceğim size.
iyi günler diliyorum.

 

[kduman]

Sayın Cems günaydın,
Allah razı olsun sizden uzun zamandır uğraştığım işi çözdüm sayenizde,ayrıca dediğiniz gibi makronun beklemeli açılması içinde wait komutunu kullandım, şu anda görünen bir problemim kalmadı.
tekrardan teşekkürler,
iyi çalışmalar dilerim.

 

[cems]

Sayın Cems günaydın,
Allah razı olsun sizden uzun zamandır uğraştığım işi çözdüm sayenizde,ayrıca dediğiniz gibi makronun beklemeli açılması içinde wait komutunu kullandım, şu anda görünen bir problemim kalmadı.
tekrardan teşekkürler,
iyi çalışmalar dilerim.

Hayırlı işler dilerim kolay gelsin...

 

[kduman]

Hayırlı işler dilerim kolay gelsin...

Sayın Cems iyi geceler,
uzun bir aradan sonra tekrar geldim, sizinle en son görüşmemize istinaden bir problemim kalmadı demiştim ama tabi rahat durmuyorum aklıma bir msgbox kutusu geldi, normalde bu mail gönderme kodu eğer ki alıcı kısmında kimse yok ise hata koduna gidiyor ve işlemi sonlandırıyor bu işlem sonlandırmasında uyarı çıkmasını istiyorum kodu ona göre yazdım ama daha sonra maili göndermemesine rağmen diğer msgbox kutusuna gidiyor ve mail gönderilmiş gibi uyarı çıkıyor, bunun çözümü nasıl olabilir acaba?
şimdiden teşekkürler iyi çalışmalar dilerim.

Private Function Ay()

Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range

If Cells(2, 2) = "" Then GoTo HATA

On Error GoTo HATA

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

saydir = WorksheetFunction.CountIf(Range("D"), "<>") + 2
DinamikAlan = "D4:" & "J" & saydir
Set Alan = Worksheets("Sayfa1").Range(DinamikAlan)

Set Sayfa = ActiveSheet

With Alan

.Parent.Select
Set daralan = ActiveCell

.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope

.Introduction = "Otomatik maildir lütfen cevap vermeyiniz!.."
With .Item
.To = Cells(2, 2)
.CC = Cells(3, 2)
.Subject = Cells(1, 2)
.bcc = ""
.Send
End With

End With

daralan.Select
End With

Sayfa.Select

HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
MsgBox "Dikkat !.. Alıcı Kısmı Boş Olduğu İçin Mail Gönderilemedi!.."
End With
Call x
End Function

Sub x()
MsgBox "Dikkat !.. Mailinizi Otomatik Olarak Gönderdiniz"
MsgBox "Çalışmanızı Kaydetmeyi Unutmayınız !..."
End Sub

 

[Saban Sertkaya]

Call x kodunu HATA: satırının üzerine alarak deneyin.

[COLOR="Red"]Call x[/COLOR]
HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
MsgBox "Dikkat !.. Alıcı Kısmı Boş Olduğu İçin Mail Gönderilemedi!.."
End With
End Function

 

[kduman]

Call x kodunu HATA: satırının üzerine alarak deneyin.

[COLOR="Red"]Call x[/COLOR]
HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
MsgBox "Dikkat !.. Alıcı Kısmı Boş Olduğu İçin Mail Gönderilemedi!.."
End With
End Function

Sayın Saban günaydın,
call x i üste alınca düzgün uyarıyı aldım kod kendini sonlandırdı fakat bu seferde alıcı kısmı dolu olunca maili gönderiyor, işlem bittikten sonra tekrar mail gönderilemedi hatası alıyorum yani tüm msgbox kutuları aktif hale geliyor.
yorumlarınız için şimdiden teşekkürler.

 

[cems]

Alıcı kısmı boş ise kalan işleme gerek yok ki, işlemden çıkması gerek ..

Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range

If Cells(2, 2) = "" Then
Msgbox " Kime göndereceğimi de söyleseydin... "
end if
exit sub

diğer kodlar aynı olarak deneyin, HATA konusu başka konu.

 

[kduman]

Alıcı kısmı boş ise kalan işleme gerek yok ki, işlemden çıkması gerek ..

Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range

If Cells(2, 2) = "" Then
Msgbox " Kime göndereceğimi de söyleseydin... "
end if
exit sub

diğer kodlar aynı olarak deneyin, HATA konusu başka konu.

Sayın Cems teşekkürler, her zamanki gibi çözdünüz konuyu elinize sağlık
iyi çalışmalar diliyorum üstad...

 

[cems]

Sayın Cems teşekkürler, her zamanki gibi çözdünüz konuyu elinize sağlık
iyi çalışmalar diliyorum üstad...

Estağfurullah, kolay gelsin