Hello,
What is the translation of this code for convert a Lotus Document to pdf :this code is working with the version 1.7:
here the code :
%REM
Agent Grouper PDF
Created Nov 6, 2015 by Freddy Merlet/HO/VERITAS
Description: Comments for Agent
%END REM
Option Public
%REM
Agent Imprimer Mail PDF
Created Nov 6, 2015 by Freddy Merlet/HO/VERITAS
Description: Comments for Agent
%END REM
'–BEGIN (OPTIONS) --> CHOOSE FOLDER DIALOG BOX
%Include “LSCONST.LSS”
Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Dim spdfpath As String
Declare Function SHBrowseForFolder Lib “shell32” Alias “SHBrowseForFolderA” (lpbi As BrowseInfo ) As Long
Declare Function SHGetPathFromIDList Lib “shell32” Alias “SHGetPathFromIDListA”( ByVal pidList As Long, ByVal lpBuffer As String ) As Long
Declare Function FindWindow95 Lib “user32” Alias “FindWindowA” ( ByVallpClassName As Any, ByVal lpWindowName As Any ) As Long
Sub Initialize
‘spdfpath = “C:\Notes\data\Dossier Tampon”
temppath = "\veuillez patienter…’"
On Error GoTo processError
Dim mode As String 'ouvert ou liste ou liste_select
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim objApp As Variant
Dim doc As NotesDocument
'Ouverture de pdfcreator
Dim PDFCreator As Variant
nbdoc = 1
Set uiview = workspace.CurrentView
verif = “erreur”
verif = uiview.Viewname
If verif = “erreur” Then
MsgBox “Sélectionner plusieurs mails (jusqu’à 20) avant de cliquer sur ce bouton.”
Exit Sub
Else
Set collection = uiview.Documents
If collection.Count < 2 Then
MsgBox “Sélectionner plusieurs mails (jusqu’à 20) avant de cliquer sur ce bouton.”
Exit Sub
ElseIf collection.Count > 20 Then
MsgBox “Ne pas sélectionner plus de 20 mails à la fois”
'on ouvre quand même un doc pour conserver les éléments sélectionnés
Set doc = collection.GetFirstDocument
Set uidoc = workspace.EditDocument(True, doc)
uidoc.Close
Exit Sub
Else
mode = “liste_select”
nbdoc = collection.Count
End If
End If
nomDefaut = Mid(Now, 7, 4) & Mid(Now, 4, 2) & Mid(Now, 1, 2) & " - " & uiview.Viewname
nomfichier = InputBox(“Nom du fichier PDF à créer.”, “”, nomDefaut)
Set objApp = CreateObject( “Shell.Application” )
'spdfpath = ChooseFolder ( "CUSTOMIZE: Put your own custom prompt message here: " )
'msgBoxType = MB_OK + MB_ICONINFORMATION
'spdfpath =filenames = workspace.SaveFileDialog( _
'False,"File name",, "c:\")
'search the value folder in the bvprofile
Dim session As New NotesSession
Dim docprofile As NotesDocument
Dim dbprofile As NotesDatabase
Set dbprofile = session.CurrentDatabase
Set docprofile = dbprofile.GetProfileDocument( "BVProfile")
Dim choices As Variant
choices = docprofile.GetItemValue( "choices" )
Dim response As Variant
response1 = workspace.Prompt (PROMPT_OKCANCELLIST, _
"Votre dossier favoris", _
"Sélectionnez votre dossier favoris sinon cliquez sur ""Cancel"".", choices, choices)
Const BIF_NEWDIALOGSTYLE = &H00000040
Const BIF_NONEWFOLDERBUTTON = &H0000200
Dim objShell As Variant
Dim objFolder As Variant
Dim objFolderItem As Variant
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Dossier Favoris", BIF_NONEWFOLDERBUTTON + BIF_NEWDIALOGSTYLE, CStr(response1))
If Not (objFolder Is Nothing) Then
Set objFolderItem = objFolder.Self
MsgBox objFolderItem.Path
response =objFolderItem.Path
End If
Dim folder, msg, msgTitle As String
Dim msgBoxType As Long
spdfpath =response
If spdfpath="" Then
spdfpath = ChooseFolder ( "Sélection de votre dossier: " )
End if
objApp.Open(spdfpath)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder(spdfpath & temppath) 'création dossier temp
Set PDFCreator = CreateObject(“PDFCreator.clsPDFCreator”)
If PDFCreator Is Nothing Then
MsgBox “Vérifier que PDFCreator est bien installé sur votre pc”,“PDFCreator n’est pas détecté”
End If
If Not PDFCreator.cStart("",True) GoTo processError
PDFCreator.cPrinterStop = True
PDFCreator.cClearCache
If mode = “liste_select” Then 'on a plusieurs docs sélectionnés
Set doc = collection.GetFirstDocument
Set uidoc = workspace.EditDocument(True, doc) 'on ouvre le premier en mode Edition
ElseIf mode = “liste” Then 'le mail n’est pas ouvert
Set uidoc = workspace.EditDocument(True) 'on l’ouvre en mode Edition
Else 'le mail est ouvert
Set doc = workspace.CurrentDocument.Document
Set uidoc = workspace.EditDocument(True, doc) 'on le ré-ouvre en mode Edition
End If
debut:
emetteur = uidoc.FieldGetText(“From”)
intitule = uidoc.FieldGetText(“Subject”)
'20 premiers caractères de l’émetteur - + les premiers caractères de l’intitulé pour faire max 100
'impression PDF
Dim PrinterPath As String
PrinterPath = “PDFCreator”
On Error GoTo impressionImpossible
Call uidoc.Print(1, 0, 0, False, PrinterPath)
On Error Resume Next
suite:
'fermeture du mail en mode Edition
Call uidoc.Close
If mode = “liste_select” Then 'si on a plusieurs docs
Set doc = collection.GetNextDocument (doc)
If Not doc Is Nothing Then 's’il en reste
Set uidoc = workspace.EditDocument(True, doc) 'on ouvre le suivant en mode Edition
GoTo debut
End If
End If
If nbdoc >0 Then
Do Until PDFCreator.cCountOfPrintjobs = nbdoc
Loop
With PDFCreator
.Ccombineall
.cOption(“UseAutosave”) = 1
.cOption(“UseAutosaveDirectory”) = 1
.coption(“AutosaveDirectory”)=spdfpath
.cOption(“AutosaveFilename”) = nomfichier & “.pdf”
.cOption(“AutosaveFormat”) = 0
End With
PDFCreator.cPrinterStop = False
While PDFCreator.cCountOfPrintjobs > 0
Sleep 1
Wend
End If
PDFCreator.cClose
testVide = False
Do Until testVide = True
Call deplace(testVide,spdfpath)
Loop
objFSO.DeleteFolder(spdfpath & temppath)
Exit Sub
impressionImpossible:
nbdoc = nbdoc-1
GoTo suite
fin:
Exit Sub
processError:
MsgBox “Vérifier que PDFCreator est bien installé sur votre pc”,“Fonctionnalité PDF n’est pas opérationnelle”
Print "Error: “+Error()+” Line: "+Cstr(Erl)
Resume fin
End Sub
Sub doublon(objFSO, debutNom, extension)
If Right(debutNom, 1) <> “.” Then
Call doublon(objFSO, Left(debutNom, Len(debutNom)-1), Right(debutNom, 1) & extension)
ElseIf Left(Right(debutNom, 4),1) = “(” And IsNumeric(Left(Right(debutNom, 3),1)) And _
Left(Right(debutNom, 2),1) = “)” Then
objFSO.MoveFile debutNom & extension, Left(debutNom, Len(debutNom) - 4) & “(” & _
Left(Right(debutNom, 3),1) +1 & “).” & extension
ElseIf Left(Right(debutNom, 5),1) = “(” And IsNumeric(Left(Right(debutNom, 4),2)) And _
Left(Right(debutNom, 2),1) = “)” Then
objFSO.MoveFile debutNom & extension, Left(debutNom, Len(debutNom) - 5) & “(” & _
Left(Right(debutNom, 4),2) +1 & “).” & extension
Else
objFSO.MoveFile debutNom & extension, Left(debutNom, Len(debutNom)-1) & " (1)." & extension
End If
End Sub
Function ChooseFolder ( dialogPrompt As String ) As String
Dim lpIDList As Long
Dim sBuffer As String * 255
Dim sReturnVal As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
sBuffer = String ( Len ( sBuffer ) , Chr(0) )
szTitle = dialogPrompt
tBrowseInfo.hWndOwner = FindWindow95 ( "notes", &H0 )
tBrowseInfo.lpszTitle = szTitle
tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
lpIDList = SHBrowseForFolder ( tBrowseInfo )
If ( lpIDList ) Then
SHGetPathFromIDList lpIDList, sBuffer
ChooseFolder = Left ( sBuffer, InStr ( sBuffer, Chr(0) ) - 1)
End If
End Function
Sub deplace(testVide,spdfpath As String)
temppath = “\veuillez patienter…’”
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objApp = CreateObject( “Shell.Application” )
'spdfpath = “C:\Notes\data\Dossier Tampon”
Set objFolder = objFSO.GetFolder(spdfpath & temppath)
Set objFiles = objFolder.Files
If objFiles.Count > 0 Then
ForAll objFile In objFiles
fileName = objFile.Name
entireFileName = spdfpath & temppath & “” & fileName
On Error GoTo erreurDoublon
objFSO.MoveFile entireFileName , spdfpath & “” & fileName
On Error Resume Next
End ForAll
Exit Sub
Else
testVide = True
Exit Sub
End If
erreurDoublon:
Call doublon(objFSO, entireFileName, “”)
Exit Sub
End Sub