unire file tiff con access 2013 64bit

Anonimo

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

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

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

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

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)

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

0 commenti

unire file tiff con access 2013 64bit

33 risposte aggiuntive