Skip to main content

AccessTr.neT


Makro İle Gönderdiğim Dosya Eski Bir Dosya Adıyla Farklı İçerikte Gidiyor

tarkanaykın
tarkanaykın
5
295

Makro İle Gönderdiğim Dosya Eski Bir Dosya Adıyla Farklı İçerikte Gidiyor

Çözüldü #1
merhaba arkadaşlar çok garip bir durumla karşı karşıyayım, ilk günlerde makro ile başarılı bir şekilde dosya gönderiyordum daha sonra başka bir dosya göndermeye karar verdim, makroda gerekli dosya ismi değişikliklerini de yaptım ama e postamı kontrol ettiğimde hala o eski dosya geliyor görünüyor, yardımlarınızı bekliyorum teşekkürler.
ilk gönderdiğim dosya adı "tespitler", onu artık iptal ettim "yaklaşanTarihler" adında yeni bir dosya göndermek istiyorum ama hala "tespitler" adlı dosya geliyor e postama.

kodlar bayağı bir düzensiz kusura bakmayın, üzgünüm.


Sub PEAKUP()

For i = 0 To 1
Dim Con As Object, Rs As Object, Sorgu As String

Set Con = CreateObject("AdoDB.Connection")

Set Rs = CreateObject("AdoDB.RecordSet")

Dim a(1) As String
a(0) = "evraklar"
a(1) = "mevraklar"

Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & ThisWorkbook.Path & "\" & a(i) & ".xlsx ;Extended Properties=""Excel 12.0;Hdr=yes"""


Sorgu = "select [evrak adı], [son tarih], [ilk tarih] from [Sayfa1$] where [son tarih]< date()+15 or [ilk tarih]< date()+15"
Rs.Open Sorgu, Con, 1, 1


Dim SonSat As Long
   
    SonSat = Cells(Rows.Count, "A").End(3).Row + 1
    Range("A" & SonSat).Select


ActiveCell.CopyFromRecordset Rs
Sorgu = vbNullString: Set Rs = Nothing: Set Con = Nothing

Next
If Range("a2").Value = "open" Then
Application.Visible = True
Exit Sub
Else

If Range("a2").Value = "" Then
Sorgu = vbNullString: Set Rs = Nothing: Set Con = Nothing
ThisWorkbook.Saved = True
Application.Quit
Else
ActiveSheet.Copy
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs "D:\tarihiYaklaşanlar.xlsx"

End With

MsgBox "tarihi yaklaşan kayıtlar var,ilgili dosyaları kontrol edin"
Call Email_CurrentWorkBook
Sorgu = vbNullString: Set Rs = Nothing: Set Con = Nothing
 
ThisWorkbook.Saved = True
Application.Quit

End If
End If
End Sub




Sub auto_open()
Application.Visible = False

Call PEAKUP

End Sub



Sub Email_CurrentWorkBook()
For i = 2 To Cells(Rows.Count, "f").End(3).Row ' burada, f2 hücresinden itibaren alt alta yazılı olan e posta adresleri var, dosyayı her birine 'göndermek için.

Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")


Set Mail = Makro.CreateItem(0)
On Error Resume Next
With Mail
.To = Range("f" & i).Value
.CC = ""
.BCC = ""
.Subject = "Örnek"
.Body = "örnektir"
.Attachments.Add ("D:\tarihiYaklaşanlar.xlsx")
.Send
End With
On Error GoTo 0
Set Mail = Nothing
Set Makro = Nothing
Next

End Sub
.rar evrakTarihKontrol5.rar (Dosya Boyutu: 17,5 KB | İndirme Sayısı: 2)
Son Düzenleme: 22/05/2022, 23:04, Düzenleyen: tarkanaykın.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Makro İle Gönderdiğim Dosya Eski Bir Dosya Adıyla Farklı İçerikte Gidiyor - Yazar: tarkanaykın - 22/05/2022, 22:56
Task