DominoArea.org [Archive]

roubech a écrit:le serveur Domino A est lancé en tant que service windows sur la machine A et essaye d'écrire sur un partage situé sur la machine B
c'est un pb de droit windows
le compte utilisé pour lancer le service est par défaut un compte admin local, qui ne peux pas accéder aux ressources reseau
une solution consiste à lancer le service avec un compte du domaine qui a les droits necessaires

Sub Initialize

Dim Session As New NotesSession
Dim db As NotesDatabase
Dim dataview As NotesView
Dim vwNav As NotesViewNavigator
Dim XLApp As Variant
Dim XLWorkBook As Variant
Dim ActiveWorkBook As Variant
Dim Sheet As Variant
Dim ligne As Long
Dim colonne As Long
Dim K As Variant
Dim Nbcolonne As Integer
Dim c As NotesViewColumn
Dim XlSheet As Variant
Dim entry As NotesViewEntry

Dim colvals As Variant
Dim scope As String
Dim doc As NotesDocument
On Error Goto Erreur


' Initialisation de la session, base actuelle et vue
Set session = New NotesSession
Set db = session.CurrentDatabase
Set dataview = db.GetView("CBP-vExtractionDAC Planning") 'SPECIFIER ICI LE NOM DE LA VUE

Set vwNav=dataview.CreateViewNav


Print "PASSAGE 1 OK"

' initialisation de l'objet OLE ou Instance OLE
' ouverture de l'application Excel sans ouverture de classeur
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = True
XLApp.DisplayAlerts = False
Set XLWorkBook=XLApp.Workbooks.Add
Set ActiveWorkBook=XLApp.ActiveWorkBook
Set Sheet=ActiveWorkBook.ActiveSheet
Sheet.Name = "DAC" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''NOM DE LA FEUILLE


Print "PASSAGE 2 OK"

'1. Ecriture du titre des colonnes


Nbcolonne=dataview.ColumnCount ' Récupère le nombre de colonne de la vue
ligne=1 ' On se place sur la première ligne
colonne=1

Set XlSheet=CreateObject("Excel.Sheet")

For K=1 To Nbcolonne
Set c=dataview.columns(K-1)
Sheet.Cells(ligne,colonne) = c.title
colonne = colonne + 1
Next K

Set entry=vwnav.GetFirstDocument


'Stop

Print "PASSAGE 3 OK"

'2. Renseigne les valeures des champs du document


ligne=2 ' On se place sur la deuxième ligne
colonne=1 'On se remet sur la premiere colonne


Do While Not (entry Is Nothing)

For colonne=1 To Nbcolonne
colvals=entry.ColumnValues(colonne-1)
scope=Typename(colvals)
Select Case scope
Case "EMPTY"
Sheet.Cells(ligne,colonne) =""
Case "STRING( )"
Sheet.Cells(ligne,colonne) =""
Case Else
Sheet.Cells(ligne,colonne) ="" + colvals
End Select


Next colonne

ligne=ligne+1

Set entry = vwnav.getnextdocument(entry)

'Stop

Loop ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''COPIE TOUTS LES VALEURS DE LA VUE


Print "PASSAGE 4 OK"



On Error GoTo Erreur2

''''''''''''''''''''''''''''' MISE EN FORME ''''''''''''''''''''''''''''''

XLApp.Range("A1:IV1").Select 'selectionne les cellules de B2 à IV2
XLApp.Selection.FONT.Bold = True 'mets la selection en gras
XLApp.Selection.Font.Size = 11 'mets la selection en police 11

Sheet.Columns.AutoFit 'calcul automatiquement la largeure des colonnes

'Aligne les cellules horizontalement et verticalement

XLApp.Range("A1:IV" & ligne).Select
Const xlCenter = -4108 'défini la constante qui permet de centré le texte
XLApp.selection.HorizontalAlignment = xlCenter
XLApp.selection.VerticalAlignment = xlCenter


Print "PASSAGE 5 OK"


'MISE A JOUR DES FICHIERS DAC SAVE ET DAC



'Sauvegarde le fichier avec la date du jour dans
'DateDuJour = Right(Date, 4) & "-" & Mid(Date, 4, 2) & "-" & Left(Date, 2)

'On Error GoTo Erreur3
XlApp.ActiveWorkBook.SaveAs "C:\Temp\Workflows_DAC"

On Error GoTo Erreur4

'XLApp.ActiveWorkBook.Close 'Ferme le fichier
'XLApp.Quit
Exit Sub


Print "PASSAGE 6 OK"


Erreur:

'XLApp.Quit
'MsgBox "PROBLEME PENDANT L'EXTRACTION DES DAC " & "( Ligne : " & ligne-1 & " Colonne : " & colonne-1 & " )",16," ERREUR !"
'Resume Fin


Erreur2:


'Stop
'XLApp.Quit
'MsgBox "PROBLEME PENDANT L'EXTRACTION AU NIVEAU DE LA MISE EN FORME"
'Resume Fin

Erreur3:
'XLApp.Quit
MsgBox "PROBLEME DANS L'ADRESSE"
Resume Fin

Erreur4:
XLApp.Quit
MsgBox "PROBLEME A LA FIN"
Resume Fin


Fin:
End Sub