unire file tiff con access 2013 64bit

Anonimo
2016-01-10T16:10:53+00:00

Buongiorno a tutti eccoomi qui per chiedere un consiglio di come procedere per un problema che si è verificato a causa del passaggio daun office 10 a 32bit ad un office 13 64bit,  il codice che ho inserito sotto mi unisce tanti tiff in uno solo senza probelmi nel 32bit, ma si blocca  col 64bit , l'errore come si può vedere è nel componente modi, dalle mie ricerche risulta che non esiste una versione per 64 bit, quindi anche installando la 32bit logicamente non funziona, ora vi chiedo che strada posso intraprendere per superare questo ostacolo, ne ho provate diverse ma sono bloccato.

ringrazio in anticipo chiunque sappia darmi qualche dritta sull'argomento..

saluti

Tanino

Public Sub MergeTiffImages()

    Dim TIFPath As String

    Dim Tiffin   As String

    Dim TIFSource As Object 'MODI.Document

    Dim TIFDest   As Object 'MODI.Document

    Dim TIFImage  As Object 'MODI.Image

     Dim strFiletiff As String

Set TIFSource = CreateObject("MODI.Document")  <-----------------------ERRORE

    Set TIFDest = CreateObject("MODI.Document")

    Set TIFImage = CreateObject("MODI.Document")

    TIFDest.Create

    Dim filename As String

    strFiletiff = "d:\archivio2" & [Forms]![salva_con_nome2]![Testo1] & ".tiff" & ""

       filename = [Forms]![salva_con_nome2]![Testo1] & ".tiff"

    TIFPath = "d:\archivio2\tiffs"   '<--- MODIFICARE"

    Tiffin = Dir(TIFPath & "*.TIFF")

    If Len(Tiffin) Then

    Do While Len(Tiffin)

      TIFSource.Create TIFPath & Tiffin

      For Each TIFImage In TIFSource.Images

        TIFDest.Images.Add TIFImage, Nothing

        Debug.Print Tiffin

        With TIFImage

          Debug.Print "TIFImage:"; .PixelWidth; "x"; .PixelHeight

        End With

        With TIFDest.Images

          With .item(.Count - 1)

            Debug.Print "TIFDest :"; .PixelWidth; "x"; .PixelHeight

          End With

        End With

        Debug.Print

      Next TIFImage

      TIFSource.Close

      Tiffin = Dir()

    Loop

    If TIFDest.Images.Count Then

      TIFDest.SaveAs "d:\archivio2" & filename & "" '

    End If

    Else

      MsgBox "Nessun file TIFF nella cartella " & TIFPath _

           , vbOKOnly Or vbExclamation _

           , "MergeTiff"

    End If

    Set TIFImage = Nothing

    Set TIFSource = Nothing

    Set TIFDest = Nothing

    DoCmd.RunSQL "insert into scantemp2 (immagine) values ('" & strFiletiff & "')"

End Sub

Microsoft 365 e Office | Access | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti
Risposta accettata dall'autore della domanda
Anonimo
2016-01-14T13:12:51+00:00

ciao Tanino,

visto che disponi di adobe Acrobat.

ho eseguito questo test giusto per provare...

maschera con command button cmdFirstFile e textBox txtFirstFile che permette di selezionare il primo file Tiff e visualizzarlo nella textbox.

altro command button cmdRestOfFiles che permette di selezionare gli altri tiff da accorpare al primo.

listbox lstRestOfFiles che permette di mostrare il file Tiff da accorpare al primo popolare in seguito all'evento click.

evento click per la scelta del primo file:

Private Sub cmdFirstFile_Click()

Me.txtFirstFile = cmdFileDialog(0)

End Sub

evento click per la scelta di tutti gli altri files:

Private Sub cmdRestOfFiles_Click()

Dim strFiles As String

Dim aFiles() As String

strFiles = cmdFileDialog(-1)

Me.lstRestOfFiles.RowSource = strFiles

aFiles = Split(strFiles, ";")

mergePDFfiles2 Me.txtFirstFile, aFiles()

End Sub

modulo standard che genera i pdf da ogni singolo tiff file e lo accopa in un unico file in PDF: Personalizza il path in cui vai a salvare i files i pdf generati  e quello ed il nome del file che contiene tutti i pdf accorpati.

dopo avere scelto gli altri files la routine mostra il file PDF JoinedTiff2.pdf con tutte le immagini accorpate.

Testato anche con A2010 64 bit tutto regolare.

Facci sapere.

ciao, Sandro.

Option Compare Database

Option Explicit

Private Const pdfJoinedPath As String = "C:\combine\pdf\JoinedTiff2.pdf"

Private Const pdfCovertedPath As String = "C:\combine\pdf"

Sub mergePDFfiles2(ByVal strFirstFile As String, _

                   ByRef strArray() As String)

On Error GoTo errorHanlder

    Dim i             As Integer

    Dim firstFile     As Object 'Acrobat.CAcroPDDoc

    Dim nFiles        As Object 'Acrobat.CAcroPDDoc

    Dim pdfFile       As String

    Dim numPages As Integer

    Set firstFile = CreateObject("AcroExch.PDDoc")

    Set nFiles = CreateObject("AcroExch.PDDoc")

    pdfFile = Tif2PDF(strFirstFile)

    DoEvents

    firstFile.Open pdfFile

    For i = 0 To UBound(strArray())

        pdfFile = Tif2PDF(strArray(i))

        nFiles.Open (pdfFile)

        numPages = firstFile.GetNumPages()

         firstFile.InsertPages numPages - 1, nFiles, _

                                      0, nFiles.GetNumPages(), True

          nFiles.Close

     Next

    firstFile.Save 1, pdfJoinedPath 'PDSaveFull

    firstFile.Close

        Application.FollowHyperlink pdfJoinedPath

ext_errorLoadAccountHandler:

    Set firstFile = Nothing

    Set nFiles = Nothing

    Exit Sub

errorHanlder:

   With Err

        MsgBox "ERR#" & .Number _

             & vbNewLine & .Description _

             , vbOKOnly Or vbCritical

      End With

      Resume ext_errorLoadAccountHandler

End Sub

Public Function cmdFileDialog(ByVal blnMultiselected As Boolean) As String

   Dim fDialog As Object

   Dim varFile As Variant

   Dim i       As Integer

    Set fDialog = Application.FileDialog(3)

    With fDialog

        .AllowMultiSelect = blnMultiselected

       .Title = "Select One or More Files"

       .Filters.Clear

       .Filters.Add "modelli di word", "*.tif"

      .InitialFileName = CurrentProject.Path & ""

       If .Show = True Then

        For i = 1 To .SelectedItems.Count

            varFile = varFile & ";" & .SelectedItems(i)

        Next

            cmdFileDialog = Mid$(CStr(varFile), 2)

       Else

          cmdFileDialog = vbNullString

       End If

    End With

End Function

Public Function Tif2PDF(ByVal strFirstFile As String) As String

Dim AcApp     As Object 'Acrobat.AcroApp

Dim TiffDoc   As Object 'Acrobat.AcroAVDoc

Dim PdfDoc    As Object 'Acrobat.AcroPDDoc

Dim justFile  As String

    Set AcApp = CreateObject("AcroExch.App")

    Set TiffDoc = CreateObject("AcroExch.AVDoc")

    Call TiffDoc.Open(strFirstFile, "")

    Set TiffDoc = AcApp.GetActiveDoc

    Set PdfDoc = TiffDoc.GetPDDoc

    justFile = justFileName(strFirstFile)

    PdfDoc.Save &H5, justFile

    PdfDoc.Close

    TiffDoc.Close True

    AcApp.Exit

    Tif2PDF = justFile

    Set PdfDoc = Nothing

    Set TiffDoc = Nothing

    Set AcApp = Nothing

End Function

Public Function justFileName(ByVal strFullPath As String) As String

     Dim s() As String

     s = Split(strFullPath, "")

     justFileName = pdfCovertedPath & Left$(s(UBound(s)), InStr(1, s(UBound(s)), ".") - 1) & ".pdf"

 End Function

La risposta è stata utile?

0 commenti

33 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2016-03-10T21:11:02+00:00

    ciao sandro, hai ragione manca proprio quello....il resto è perfetto funziona benissimo, sarebbe meglio non essere obbligati a scrivere .pdf, anche perchè la mia idea e di farlo per essere utilizzato da terze parti.....

    grazie ancora

    Tanino :-)

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2016-03-10T19:54:49+00:00

    Ciao sandro grazie del consiglio ora lo provo e ti farò sapere.

    un saluto

    Tanino :-)

    La risposta è stata utile?

    0 commenti
  3. Anonimo
    2016-03-10T18:28:59+00:00

    ciao Tanino,

    inserisci una textBox nella maschera2 e chiamala txtFileMerged in cui inserirai solo il nome del con estensione tipo pippo.pdf

    modifica l'evento click del command button in questo modo :

    Private Sub cmdMerging_Click()

    mergePDFfiles2 Me.lstRestOfFiles, Me.lblFile, Me.txtFile, Me.txtFileMerged

    End Sub

    la sub così :

     Sub mergePDFfiles2(ByVal lst As Access.ListBox, _

                        ByVal lbl As Access.Label, _

                        ByVal txt As Access.TextBox, _

                   ByVal varMergeD As Variant)

    questa instruzione :

    firstFile.Save 1, pdfJoinedPath '1=PDSaveFull

    la cambi così :

    firstFile.Save 1, Nz((pdfCovertedPath + varMergeD), pdfJoinedPath)

    questa:

    Application.FollowHyperlink pdfJoinedPath

    così :

     runFile Nz((pdfCovertedPath + varMergeD), pdfJoinedPath)

    ed inserisci sempre nel modulo1 questa sub :

    Private Sub runFile(ByVal strfullPath As String)

    Dim ret As Integer

    ret = Shell("rundll32.exe url.dll,FileProtocolHandler " & strfullPath, vbMaximizedFocus)

    End Sub

    in questo modo se inserisci il nome del file nella textBox personalizzi il nome del file PDF che contiene i TIFF merged

    altrimenti lo salvi con JoinedTiff2.pdf.

    Cosa manca? il controllo che il file abbia l'estensione e che sia corretta. :-)

    Intanto prova questa strada.

    ciao, Sandro.

    La risposta è stata utile?

    0 commenti
  4. Anonimo
    2016-03-10T15:34:33+00:00

    Ciao sandro vorrei chiederti un'ultima cosa, vorrei dare un nome a mio piacimento al file "JoinedTiff2.pdf" ad esempio scrivendolo in una textbox che inserirò nella maschera2.

    io ho provato così ma non mi da risultati anche se ho già usato un metodo come questo, mi daresti qualche consiglio...

    ho provato così:

    Private Const pdfJoinedPath As String = "D:\archivio2\tiffs\pdf" & [Forms]![maschera2]![Testo8] & ".pdf" & ""

    grazie in anticipo

    Tanino

    La risposta è stata utile?

    0 commenti