Excel dosyalarındaki verileri karşılaştırmak

[makarabulut]

Merhaba,

Bir klasör içinde birden fazla Excel dosyam mevcut. Amacım yazdığım makronun, klasöre her yeni bir Excel dosyası eklediğimde bir önceki güne ait Excel dosyası ile içereğini karşılaştırması ve farklı olan verileri bir txt dosyasına yazdırması. Bunu Excel VBA kullanarak nasıl yapabilirim?

[makarabulut]

Merhaba,

Bu sorunun cevabı olarak aşağıdaki kodları şu adresten buldum : https://www.excel.web.tr/threads/outloo ... me.176473/

Ama Set objNS = Application.GetNamespace("MAPI") satırında hata alıyorum sebebi ne olabilir?

Kod: Tümünü seç

Public Sub mailleri_kaydet()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Atts As Outlook.Attachments
  Dim Att As Outlook.Attachment
  Dim Sel As Outlook.Selection
  Dim i&, Msg$
  Dim lFileNr As Long
 
    Set objNS = Application.GetNamespace("MAPI")
    Set Inbox = objNS.PickFolder

    If TypeName(Inbox) <> "Nothing" Then
       If Inbox.Items.Count = 0 Then
          MsgBox "Seçilen " & Inbox & " klasöründe mail bulunamadı", vbInformation, "Mail bulunamadı."
          Exit Sub
       End If
    Else
        Set Inbox = Nothing
        Set objNS = Nothing
        Exit Sub
    End If

  kaydetklasor = "c:\temp"
  For Each obj In Inbox.Items
      sExt = ".msg"
      sname = isimtemizle(obj.Subject)
      dtDate = obj.ReceivedTime
      sname = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
      vbUseSystem) & Format(dtDate, "-hhnnss", _
      vbUseSystemDayOfWeek, vbUseSystem) & "-" & sname & sExt
      obj.SaveAs kaydetklasor & "\" & sname, olSaveAsMsg
 
  Next
End Sub

Function isimtemizle(strFileNameIn As String) As String
    Dim i As Integer
    Const strIllegals = "\/|?@*<>"":"
    For i = 1 To Len(strIllegals)
        strFileNameIn = Replace(strFileNameIn, Mid$(strIllegals, i, 1), "_")
    Next i
    isimtemizle = strFileNameIn
End Function

[GuardofDeath17]

Merhaba,

Bu sorunun cevabı olarak aşağıdaki kodları şu adresten buldum : https://www.excel.web.tr/threads/outloo ... me.176473/

Ama Set objNS = Application.GetNamespace("MAPI") satırında hata alıyorum sebebi ne olabilir?

Kod: Tümünü seç

Public Sub mailleri_kaydet()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Atts As Outlook.Attachments
  Dim Att As Outlook.Attachment
  Dim Sel As Outlook.Selection
  Dim i&, Msg$
  Dim lFileNr As Long
 
    Set objNS = Application.GetNamespace("MAPI")
    Set Inbox = objNS.PickFolder

    If TypeName(Inbox) <> "Nothing" Then
       If Inbox.Items.Count = 0 Then
          MsgBox "Seçilen " & Inbox & " klasöründe mail bulunamadı", vbInformation, "Mail bulunamadı."
          Exit Sub
       End If
    Else
        Set Inbox = Nothing
        Set objNS = Nothing
        Exit Sub
    End If

  kaydetklasor = "c:\temp"
  For Each obj In Inbox.Items
      sExt = ".msg"
      sname = isimtemizle(obj.Subject)
      dtDate = obj.ReceivedTime
      sname = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
      vbUseSystem) & Format(dtDate, "-hhnnss", _
      vbUseSystemDayOfWeek, vbUseSystem) & "-" & sname & sExt
      obj.SaveAs kaydetklasor & "\" & sname, olSaveAsMsg
 
  Next
End Sub

Function isimtemizle(strFileNameIn As String) As String
    Dim i As Integer
    Const strIllegals = "\/|?@*<>"":"
    For i = 1 To Len(strIllegals)
        strFileNameIn = Replace(strFileNameIn, Mid$(strIllegals, i, 1), "_")
    Next i
    isimtemizle = strFileNameIn
End Function

Outlook namespace olan objNS objesini şu şekilde ayarlayıp dener misin?

Kod: Tümünü seç

Dim objApp As Outlook.Application
Set objApp = New Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")