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-03T22:01:41+00:00

    ciao Tanino,

    imposta il rowSource della listbox della demo a tabella/query e la sua origine riga a T_tiffs, colonna associata 1 larghezza 5 cm-.

    crea una tabella nuova rinominandola T_Tiffs con un campo testo, il cui nome di pura fantasia è filesTiffs.

    inserisci questi due eventi nella form maschera1 :

    Private Sub Form_Load()

    tiffFiles

    Me.lstRestOfFiles.Requery

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

     DBEngine(0)(0).Execute "delete * from t_tiffs", dbFailOnError

    End Sub

    e  modifica l'evento click del command button cmdRestOfFiles così' :

    Private Sub cmdRestOfFiles_Click()

    mergePDFfiles2 Me.txtFirstFile, Me.lstRestOfFiles

    End Sub

    copia incolla il seguente codice in un modulo standard :

    Option Compare Database

    Option Explicit

    Private Const strPath As String = "C:\Users\sandro\Desktop\combine"  '<---- personalizza il path

    Public Sub tiffFiles()

    On Error GoTo errorHandler

     Dim strFile     As String

     strFile = Dir(strPath)

    DBEngine.BeginTrans

     Do While strFile <> ""

         If (GetAttr(strPath & strFile) And vbDirectory) = 0 Then

             If justExtentionFileName(strFile) Then

                 DBEngine(0)(0).Execute "insert into t_tiffs (filesTiffs) values ('" & strFile & "')", dbFailOnError

             End If

         End If

         strFile = Dir

     Loop

    DBEngine.CommitTrans

    ext_errorLoadAccountHandler:

        Exit Sub

    errorHandler:

       With Err

           DBEngine.Rollback

           MsgBox "ERR#" & .Number _

                & vbNewLine & .Description _

                , vbOKOnly Or vbCritical

         End With

         Resume ext_errorLoadAccountHandler

    End Sub

    Private Function justExtentionFileName(ByVal strFullPath As String) As Boolean

    Dim strEXT As String

    Dim bool   As Boolean

    strEXT = Mid$(strFullPath, InStrRev(strFullPath, "."), Len(strFullPath))

    If strEXT = ".TIF" Or strEXT = ".TIFF" Then bool = Not bool

    justExtentionFileName = bool

    End Function

    personalizza il path esattamente dove vedi il commento sopra inserendo il path del folder che contiene i files tiff.

    In seguito a tutte le modifiche sopra indicate, all'apertura della form maschera1 vedrai all'interno della listbox- in cui prima selezionavi i restanti files- popolarsi con i soli files con estensione tiff o tif (se ci sono nella cartella, altrimenti non vedi nulla).

    A questo punto seleziona il file, il primo con il solito command button cmdFirstFile e poi il command button rest of files lancerà la routine di merging, la seguente, opportunamente modificata come segue :

     Sub mergePDFfiles2(ByVal strFirstFile As String, _

                        ByVal lst As Access.ListBox)

     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())

         For i = 0 To lst.ListCount - 1

             pdfFile = Tif2PDF(pdfCovertedPath & lst.Column(0, i))

             nFiles.Open (pdfFile)

             numPages = firstFile.GetNumPages()

             firstFile.InsertPages numPages - 1, nFiles, _

                                           0, nFiles.GetNumPages(), True

             nFiles.Close

          Next

          firstFile.Save 1, pdfJoinedPath '1=PDSaveFull

          firstFile.Close

         Set firstFile = Nothing

         Set nFiles = Nothing

         VBA.MsgBox "Completato!", vbInformation, "Avviso"

         Application.FollowHyperlink pdfJoinedPath

    ext_errorLoadAccountHandler:

         Exit Sub

    errorHanlder:

        With Err

             MsgBox "ERR#" & .Number _

                  & vbNewLine & .Description _

                  , vbOKOnly Or vbCritical

           End With

           Resume ext_errorLoadAccountHandler

    End Sub

    ora, prevedo la prossima domanda....non si può combinare i files che vedo nella listbox senza selezionare il primo?

    ancora un grazie  :)un saluto

    prego :-).

    ciao, Sandro.

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2016-03-03T20:24:42+00:00

    Ciao sandro ora è tutto perfetto, sbagliavo una cosa ovvia ma capita che le cose più semplici ti sfuggano, praticamente c'era 'cmdFileDialog' anche in un'altro modulo ed entrava in confusione, ho solo modificto il nome ed è andato tutto benissimo.

    grazieeeee mi hai salvato la vita.

    ora ti stresso con una domanda poi ti lascio in pace "almeno per un po"...riguarda proprio il comando per l'inserimento in listbox, vorrei che portasse il contenuto della cartella senza selezionare i file, con questa stringa .InitialFileName = "d:\Archivio2\tiffs" apre direttamente la cartella che mi serve ma devo selezionarli io , insomma vorrei saltare la parte dove evidenzio i file allo scopo di automatizzare il software, tanto al suo interno ci vanno solo i file scansionati per essere uniti.

    accetto ogni consiglio o dritte su dove cercare.

    ancora un grazie  :)un saluto

    Tanino

    La risposta è stata utile?

    0 commenti
  3. Anonimo
    2016-03-03T18:22:15+00:00

    ciao Tanino,

    il link è questo : http://1drv.ms/1XTKe6l

    ed il file si chiama taninoTiff.accdb.

    copia/incolla nel web browser solo il link  http://1drv.ms/1XTKe6l 

    la demo è disponibile  :

    ciao, Sandro.

    La risposta è stata utile?

    0 commenti
  4. Anonimo
    2016-03-03T17:45:02+00:00

    ciao sandro grazie della risposta, no non ho chiamato il modulo come la funzione, per quanto riguarda la tua demo reperibile al link http://1drv.ms/1XTKe6l taninoTiff.accdb., praticamente quando apro il link mi da una pagina bianca e nin vedo nulla quindi non posso scaricarla...

    un saluto

    Tanino

    La risposta è stata utile?

    0 commenti