XL als LogFile für PDF-Aktivitäten

[d'r Bastler]

Moin allerseits,

man schickt regelmäßig PDFs aus WD per OL und möchte gerne bei jedem Versand einen Listeneinträg in XL generieren? Wie das mit dem Verschicken von Krams aus WD oder XL geht, ist hier schon beschrieben. Den Listeneintrag (Code in ThisDocument) gibts hier:

Code: Alles auswählen

Option Explicit

Sub PutPDFtoXLsheet()
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim wdDoc As Document, wdPath As String, sPDF As String, sLfd As String
Dim iRow As Integer, iPos As Integer, iLfd As Integer

Set wdDoc = ThisDocument
wdPath = wdDoc.Path & "\"
sPDF = InputBox("PDF-Name eingeben") & ".PDF"               'Die Eingabe wird umd die Datei-Endung ergänzt

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(wdPath & "PDFtoXL.xlsx")  'Das XL-Workbook wird im selben Verzeichnis wie das Word-Dokument erwartet >>> ANPASSEN
Set xlSheet = xlBook.Sheets("PDF-Liste")                    'Ein Sheet mit eindeutigem Namen wird gebraucht >>> ANPASSEN

With xlApp
    With xlSheet
        iRow = .Cells(xlSheet.Rows.Count, 1).End(-4162).Row
            iPos = InStr(.Cells(iRow, 1), "-")                                              'Auslesen der vorherigen Lfd
            sLfd = Right(.Cells(iRow, 1), Len(.Cells(iRow, 1)) - iPos)
            iLfd = CInt(sLfd) + 1                                                           'Erhöhen um 1
        .Cells(iRow + 1, 1) = Date & "-" & iLfd                                             'Einträge in die erste freie Zeile
        .Cells(iRow + 1, 2) = sPDF
            xlApp.DisplayAlerts = False
            xlBook.Save
        If MsgBox(.Cells(iRow + 1, 1) & vbTab & .Cells(iRow + 1, 2), vbYesNo, "Aktualisierte Liste anzeigen?") = vbYes Then
            xlApp.Visible = True
            Exit Sub
        End If
    End With
End With

xlApp.Quit

End Sub

XL sollte (noch) beim Aufruf geschlossen sein und es braucht eine erste Zeile in XL im Format Datum & "-" & nnn. Weiteres dazu später

lg allerseits - möge es Euch besser gehen als mir krankem Hahn.

[thowe]

....,

Was bitte ist WD aus OL....

[knobbi38]

aus WD per OL

... aus Word heraus per Outlook ...

[d'r Bastler]

Moin thowe,
die linke Hälfte der Liste zeigt die von Microsoft verwendeten Präfixe für die Objekte der verschiedenen Apps. Auf der rechten Seite findest Du meine eigene Nomenklatur, die sich an folgender einfacher Bildungsregel orientiert: Immer nur zwei Buchstaben und einfach jeweils die ersten einer Silbe bzw. bei WD und XL gut erkennbare Ausnahmen:

WD: Microsoft Word = WD
XL: Microsoft Excel = XL
PP: Microsoft PowerPoint = PP
AC: Microsoft Access = AC
OT: Microsoft OneNote = ON
OP: Microsoft Outlook = OL (was das MS-P hier soll, ist mir schleierhaft)
MP: Microsoft Project = PJ
PUB: Microsoft Publisher = PL
VIS: Microsoft Visio= VO

Die Aküs tauchen so häufig in Forentexten auf, werden aber eben auch als Präfix für Objekte verwendet: wdApp, olItem, xlBook, ...

lg (kein Präfix ... )

[d'r Bastler]

als Nachtrag zum Code oben: Bitte die letzten Zeilen des Codes ergänzen:

Code: Alles auswählen

xlBook.Close
xlApp.Quit

Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

End Sub

Dank an Knobbi!
Grüße

[knobbi38]

Hallo,

hier mal ein etwas andere Ansatz, bei dem die XL-Datei mehr als Objekt "benutzt" wird und die Interna für die Verwendung in der aufrufenden Anwendung keine Rolle spielen bzw. verdeckt sind:

1. Excel Datei als "Journal" mit einem Listobject "tblJournal" und den Spalten "ID, Datum, Dateiname".

Code: Alles auswählen

' *****************************************************************************
' Modul: modTableUtils
' *****************************************************************************
Option Explicit

' Defined named table
Const TBL_JOURNAL As String = "tblJournal"

' Shortcut for Application.WorksheetFunction
Public Property Get wsf() As WorksheetFunction
  Set wsf = Application.WorksheetFunction
End Property

' Append a new row to the journal
Public Function NewRecord(ByVal vData As Variant) As Variant
  Dim table As ListObject
  Dim lstRow As ListRow
  
  Set table = Range(TBL_JOURNAL).ListObject
  Set lstRow = table.ListRows.Add
  lstRow.Range = Array(GetNextID(table), Date, vData)
  NewRecord = lstRow.Index
End Function

' Calculate the next unique ID
Private Function GetNextID(ByRef table As ListObject) As Long
  GetNextID = CLng(wsf.Max(Range(table.Name & "[ID]"))) + 1
End Function

' Just for testing ...
Public Sub Test_Sample()
  NewRecord "Testdatei.pdf"
End Sub

2. Aufruf aus einer Word-Datei oder Outlook oder ... per Automation:

Code: Alles auswählen

Sub AppendToJournal()
  Dim xlApp As Object
  Dim wkb As Object
  
  Const XL_JOURNAL_FILE As String = "X:\Journal.xlsm"
  
  ' Open journal
  Set xlApp = CreateObject("Excel.Application")
  Set wkb = xlApp.Workbooks.Open(XL_JOURNAL_FILE)
  
  ' Append new journal item
  Call xlApp.Run("NewRecord", "MyFilename4")
  
  ' Save changes
  wkb.Close SaveChanges:=Not wkb.Saved
  
  ' Cleanup
  Set wkb = Nothing
  xlApp.Quit: Set xlApp = Nothing
End Sub

Der Vorteil ist, daß der Aufrufer keine Ahnung davon haben muß, wie die Daten in der XL-Datei weiter verarbeitet werden. Damit kann die Verarbeitung in Excel geändert werden, ohne das die aufrufenden Anwendungen angepasst werden müssten.
Der Nachteil ist eventuell, daß aus der "normalen" Xlsx-Datei jetzt eine mit Makros geworden ist.

Gruß
Knobbi38