Just nu i M3-nätverket
Gå till innehåll

Etiketter med mailmerge från Excel-Db strular...


MvS
 Share

Rekommendera Poster

Jag har gjort en databas i Excel 2013 åt en kompis för hans stora skivsamling. Jag försöker att skapa ett automatiserat flöde där det enkelt ska gå att skriva ut etiketter ur samlingen att fästa på hyllor och lådor där skivorna förvaras. För detta ändamål har jag skapat tre etikettmallar i Word för olika tidsperioder (Mall 1 = 1950 - 1970. mall 2 = 1970 - 1990, mall 3 = Från 1990) som kan användas att märka upp de många lådor som skivsamlingen finns i.

Jag har försökt hitta VBA-kod som kan bistå med detta så att man bara behöver klicka på en knapp i Excel-databasen för att automatiskt skapa en etikettserie  i Word (mailmerge). Det verkar funka så långt att Word öppnar och påbörjar mailmerge med sen hänger sig programmet i flera minuter och Word kraschar. 

Så här ser min kod ut för första tidspannet (1950-1970):

Private Sub Document_Open()

    Dim wd As Object
    Dim wDocSource As Object, wDocPath As String
    Dim strWorkbookName As String
    Set wDocSource = ThisDocument
    wDocPath = ThisDocument.Path
    strWorkbookName = wDocPath & "\Etiketter+Db.xlsm"
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    wDocSource.MailMerge.OpenDataSource Name:= _
        strWorkbookName, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM `Db$`"

    With wDocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    ActiveDocument.SaveAs2 FileName:= _
                wDocPath & "\Etiketter_Pre-1970.docx", _
                FileFormat:=wdFormatXMLDocument
    ChangeFileOpenDirectory _
        wDocPath
    ActiveDocument.SaveAs2 FileName:= _
        wDocPath & "\Etiketter_Pre-1970.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

End Sub

Då jag kapar sekvensen efter SQLStatement  (i.e. INNAN begäran om att fullfölja mailmerge) så verkar det gå bra, men då måste man "manuellt" välja "Slutför och koppla" för att etikettserien ska genereras och jag vill att hela processen ska funka automatiskt så att det bara är för användaren att skriva ut! Grunddelen av VBA-koden ovan har jag fått genom en makroinspelning och sedan har jag lagt till delar jag hittat på nätet. En märklig sak dock är att själva filtreringen jag gör underinspelningen i "Redigera mottagarlista" kommer av någon anledning inte med i koden - varför då?

Jag har också prövat att lägga in "WHERE" argument i SQL-statement efter tips när jag Googlat runt men då hittar inte Word sökvägen till Excel-filen och dokumentet kan inte öppna!

Känner spontant att detta bara måste funka men antagligen är det något knas med kodningen som ställer till det. Om det finns någon i forumet som har råkat ut för motsvarande och till äventyrs hittat en bra lösning vore jag stort tacksam för hjälp!

 

 

Länk till kommentar
Dela på andra webbplatser

  • 2 veckor senare...

Aldrig gjort något liknande, tycker den guide som finns i Word är bra nog.

 

Du säger själv var det tar stopp och det får mig att fråga hur många träffar du får med din SQL-sats.

 

Om du testar att sätta källan, excel-arkets range på annat sätt, mer hårdkodat, fungerar då resten av koden?

Länk till kommentar
Dela på andra webbplatser

Tack för svar!
Menar du att jag redan i källdokumentet (Excel-tabellen) kan styra filtret? Som det ser ut nu har jag följande kod i Excel:

Sub Etiketter()

	On Error Resume Next
        Set ws = Sheets("Lista")
        Dir = ThisWorkbook.Path
        Opt = ws.Range("O1")
        Set objWord = CreateObject("Word.Application")
        objWord.Activate
    objWord.Visible = True
    AppActivate (objWord.Windows(1).Caption)
        Select Case Opt
            
            Case Is = 2                                     ' Före 1970
            Result = objWord.Documents.Open(Dir & "\Etiketter_1.docm")
            AppActivate (objWord.Windows(2).Activate)
'            & (objWord.Windows("Etiketter_1.docm").Close)
                
                Case Is = 3                                 ' Mellan 1970 och 1990
                Result = objWord.Documents.Open(Dir & "\Etiketter_2.docm")
                AppActivate (objWord.Windows(2).Activate)
'                & (objWord.Windows("Etiketter_2.docm").Close)
                    
                    Case Is = 4                             ' Efter 1990
                    Result = objWord.Documents.Open(Dir & "\Etiketter_3.docm")
                    AppActivate (objWord.Windows(2).Activate)
'                    & (objWord.Windows("Etiketter_3.docm").Close)
                        
                        Case Is = 1                         ' Om inget av ovanstående
                        Result = objWord.Documents.Open(Dir & "\Etiketter_3.docm")
                        AppActivate (objWord.Windows(2).Activate)
'                        & (objWord.Windows("Etiketter_3.docm").Close)
        End Select
    Call Workbook_RefreshAll

End Sub

Jag har således tre olika dokument (Word) med etikettmallar som jag vill öppna beroende på hur jag filtrerat på tidsperiod.  Det vore ju bra om jag redan härifrån kunde styra urvalet!

Länk till kommentar
Dela på andra webbplatser

Ah du öppnar Word från Excel och hoppas gå igenom hela processen.

ja du jag vet nog inte mer utan att testa det hela själv.

Länk till kommentar
Dela på andra webbplatser

 Share



×
×
  • Skapa nytt...