vbs - scrive dati foglio Excel in file csv per stampa mailmerge etichette in Word

'

' vbs - scrive dati foglio Excel in file csv per stampa mailmerge etichette in Word

'

Sub ScriviFoglioCsvSql()

Dim quanterighe, contarighe, foglio, contacolonne, quantecolonne, contenuto

'

Dim cartellafile, fs, a, archivio, stesto, nomefile

cartellafile = "C:\etichette-csv\"

nomefile = "etichette-" & Format(Now(), "yyyymmddmms") & ".txt" ' & ".csv"

archivio = cartellafile & nomefile

'

'

Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile(archivio, True)

'

Set foglio = Sheets(ActiveSheet.Name)

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

quantecolonne = Range(foglio.UsedRange.Cells(1, foglio.UsedRange.Columns.Count).Address).Column

'

quantecolonne = 6

'

contarighe = 1

While contarighe <= quanterighe

   contacolonne = 1

   stesto = ""

   While contacolonne <= quantecolonne

      contenuto = foglio.Cells(contarighe, contacolonne).Value

      contenuto = Replace(contenuto, ";", " ")

      contenuto = contenuto & ";"

      stesto = stesto & contenuto

      contacolonne = contacolonne + 1

   Wend

   '

   a.WriteLine (stesto)

   '

   contarighe = contarighe + 1

Wend

'

a.Close

'

Dim cartella, documento, nomedoc

cartella = "C:\etichette-csv\"

documento = cartella & "b-etichette-105x37 - Copia.doc"

'

Dim oApp, wdDoc

'

Set oApp = CreateObject("Word.Application")

oApp.Visible = True

'

Set wdDoc = oApp.Documents.Open(documento)

'

With oApp

    nomedoc = .ActiveDocument.Name

   .Activate

   .Documents(nomedoc).Activate  ' setta il riferimento al documento

End With

'

 wdDoc.MailMerge.OpenDataSource Name:= _

        archivio, ConfirmConversions:=False, _

        ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _

        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _

        WritePasswordTemplate:="", Revert:=False, Format:=0, _

        Connection:="", SQLStatement:="", SQLStatement1:="", SubType:=0

 

  wdDoc.MailMerge.Execute

'

oApp.Documents(documento).Close SaveChanges:=wdDoNotSaveChanges

'

End Sub

'

'