OVH Cloud OVH Cloud

Résultat de fonction parfois en police asiatique

2 réponses
Avatar
Steph
Bonjour à tous,
J'ai un phénomène étrange.
J'ai récupéré un code qui récupère l'utilisateur et le nom de PC.
J'utilise ces données pour contrôler une base de
gestion/validation/approbation de documents sous assurance qualité.
Mais parfois, sans que ce soit reproductible, lorsque la séquence
suivante s'exécute :

Dim MaBase As Database, rst As Recordset
Set MaBase = CurrentDb
Set JeuEnregistrement = MaBase.OpenRecordset("tbl_appobation")
With JeuEnregistrement
.AddNew
![str_refdoc] = str_refdoc
![str_indice] = str_indice
![d_dateenvois] = Date
![str_iduser_demandeur] = lpUserName
![str_idposte_demandeur] = NomPC
![str_type_envois] = "Validation"
![str_demander_a] = str_rs
.Update
End With
MaBase.Close
Les données sont inscrites en caractères asiatique.
Je n'ai aucune piste, idée... quoi que ce soit qui me permette de
trouver l'erreur ou la cause.

Quelqu'un aurait une idée....
Merci par avance.


*******************
Option Compare Database
' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Const NoError = 0 'The Function call was successful
'Création des délarations
'on affecte les déclarations
Dim str_refdoc As String
Dim str_symbole As String
Dim str_nidentite As String
Dim d_datecreation As Date
Dim str_libelle As String
Dim str_indice As String
Dim str_section As String
Dim str_rs As String
Dim str_rs_approbation As String
Dim str_corps_mail As String
Dim str_modi_effectue As String
************************************

J'appelle la fonction depuis un formulaire :

***********************************
Function demvalidation()
str_refdoc = Form_Documents.Ref_doc.Value
If IsNull(Form_Documents.Symbole.Value) Then
str_symbole = " "
Else
str_symbole = Form_Documents.Symbole.Value
End If

If IsNull(Form_Documents.N°_d_iden.Value) Then
str_nidentite = " "
Else
str_nidentite = Form_Documents.N°_d_iden.Value
End If

d_datecreation = Form_Documents.Date_création.Value

str_libelle = Form_Documents.Libellé.Value

'on recherche les dernières valeurs d'indice a partir du ref doc
str_indice = DMax("[Indice]", "suivis des indices", "[Ref doc]= '" &
str_refdoc & "'")

'on recherche le destinataire à partir de la section
str_section = Form_Documents.Modifiable45.Value
str_rs = DLookup("[rs]", "Section", "[Section]= '" & str_section & "'")
str_rs_approbation = DLookup("[app]", "Section", "[Section]= '" &
str_section & "'")

' on récupère le texte de modification correspondant au str_refdoc et
str_indice
Dim str_critere As String
str_critere = "[Ref doc]= '" & str_refdoc & "' And [Indice]= '" &
str_indice & "'"
str_modi_effectue = DLookup("[Modification effectuée]", "suivis des
indices", "[Indice] = '" & str_indice & "' AND [Ref doc] = '" &
str_refdoc & "'")
str_modi_effectue = DLookup("[Modification effectuée]", "suivis des
indices", str_critere)
If IsNull(str_modi_effectue) Then
str_modi_effectue = "Modification non référencée"
Else
str_modi_effectue = DLookup("[Modification effectuée]", "suivis
des indices", str_critere)
End If

'""""""""""""""""""""""""""""
'On recherche le type de document à envoyer
Dim str_libelle_type_doc As String
'construction du critère de recherche du type de document
Dim str_critere_recherche_doc As String
Dim str_extrait_chaine
str_extrait_chaine = Mid(str_refdoc, 3, 2)
str_critere_recherche_doc = "[str_abrege]= '" & str_extrait_chaine & "'"
str_libelle_type_doc = DLookup("[str_libelle_doc]", "tbl_abreviation",
str_critere_recherche_doc)

'"""""""""""""""""""""""""""""""""""""""""""
'On récupère le nom user et le nom machine
' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
MsgBox "Unable to get the name."
End
End If

Dim lngLongueur As Long
Dim strTampon As String
Dim intR As Integer
strTampon = Space(255)
lngLongueur = Len(strTampon)
intR = GetComputerName(strTampon, lngLongueur)
NomPC = Left(strTampon, lngLongueur)

'###########################################
'On recherche si la validation n'a pas déjà été envoyé
Dim str_etat_validation As String
Dim str_criterea As String
str_criterea = "[str_refdoc]= '" & str_refdoc & "' And [str_indice]= '"
& str_indice & "'"
If IsNull(str_etat_validation = DLast("[str_type_envois]",
"tbl_appobation", str_criterea)) Then
str_etat_validation = "0"
Else
str_etat_validation = DLast("[str_type_envois]", "tbl_appobation",
str_criterea)
End If

'str_etat_validation = DLast("[str_type_envois]", "tbl_appobation",
str_criterea)
'Dim str_estvalider As String
'str_estvalider = "[Ref doc]= '" & str_refdoc & "' And [Indice]= '" &
str_indice & "'"


If str_etat_validation = "0" Then
' si rien existe, on envoye la demande de validation
Call envoievalidation
Else

Select Case str_etat_validation
'sinon on vérifie le dernier enregistrement
Case "Validation"
' La validation existe, on vérifie que c'est validé et
correctement renseigné
Dim d_date_renseignee As Date
Dim str_coche_approuve As String
Dim str_critere1 As String
'connstruction de la chaine du critere de recherche
str_critere1 = "[str_refdoc]= '" & str_refdoc & "' And
[str_indice]= '" & str_indice & "' And [str_type_envois]= '" &
str_etat_validation & "'"

str_coche_approuve = DLast("[str_appouvé]", "tbl_appobation",
str_critere1)
'Si la date de validation n'existe pas ou le document n'est pas validé
If IsNull(d_date_renseignee = DLast("[d_date_resultat]",
"tbl_appobation", str_critere1)) Or str_coche_approuve <> -1 Then
Dim int_action
int_action = MsgBox("Le document n'est pas validé ou les
champs ne sont pas correctement renseignés, voulez-vous poursuivre et
ré-envoyer une demande de validation ?", vbCritical + vbOKCancel,
"Erreur de suivis")
If int_action = 1 Then
Call envoievalidation
Else
MsgBox "Demande annullée avec succès"
Exit Function
End If
Else
'on envoye la demande d'approbation
Call envoieconfirmation
End If

Case "Approbation"
' L'approbation existe, on vérifie que c'est approuve et
correctement renseigné

'connstruction de la chaiine du critere de recherche
str_critere1 = "[str_refdoc]= '" & str_refdoc & "' And
[str_indice]= '" & str_indice & "' And [str_type_envois]= '" &
str_etat_validation & "'"

str_coche_approuve = DLast("[str_appouvé]", "tbl_appobation",
str_critere1)
'Si la date de validation n'existe pas ou le document n'est pas validé
If IsNull(d_date_renseignee = DLast("[d_date_resultat]",
"tbl_appobation", str_critere1)) Or str_coche_approuve <> -1 Then
Dim int_action2
int_action2 = MsgBox("Le document n'est pas approuvé ou les
champs ne sont pas correctement renseignés,, voulez-vous poursuivre et
ré-envoyer une demande de validation ?", vbCritical + vbOKCancel,
"Erreur de suivis")
If int_action2 = 1 Then
Call envoievalidation
Else
MsgBox "Demande annulée avec succés"
'on arrête la fonction
Exit Function
End If
Else
'on envoye la diffusion
Call envoiediffusion
End If

Case "Diffusion"
MsgBox "Le document est validé, approuvé et diffusé, aucune
opération n'est nécessaire sur cet indice", vbCritical + vbOKOnly,
"Traitement des validations"
Exit Function


End Select
End If

End Function

**********************************

Function verification_validation()
'"""""""""""""""""""""""""""""""""""""""""""
'On récupère le nom user et le nom machine
' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
MsgBox "Unable to get the name."
End
End If

Dim lngLongueur As Long
Dim strTampon As String
Dim intR As Integer
strTampon = Space(255)
lngLongueur = Len(strTampon)
intR = GetComputerName(strTampon, lngLongueur)
NomPC = Left(strTampon, lngLongueur)


' Display the name of the person logged on to the machine.
' MsgBox "The person logged on this machine is: " & lpUserName & NomPC
Dim user_demandeur As String
Dim poste_demander As String



End Function



Function envoievalidation()
'""""""""""""""""""""""""""""
'On recherche le type de document à envoyer
Dim str_libelle_type_doc As String
'construction du critère de recherche du type de document
Dim str_critere_recherche_doc As String
Dim str_extrait_chaine
str_extrait_chaine = Mid(str_refdoc, 3, 2)
str_critere_recherche_doc = "[str_abrege]= '" & str_extrait_chaine & "'"
str_libelle_type_doc = DLookup("[str_libelle_doc]", "tbl_abreviation",
str_critere_recherche_doc)
'"""""""""""""""""""""""""""""""""""""""""""
'On récupère le nom user et le nom machine
' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
MsgBox "Unable to get the name."
End
End If

Dim lngLongueur As Long
Dim strTampon As String
Dim intR As Integer
strTampon = Space(255)
lngLongueur = Len(strTampon)
intR = GetComputerName(strTampon, lngLongueur)
NomPC = Left(strTampon, lngLongueur)
'envoyer un mail de confirmation

'MsgBox "'" & str_rs & "'"
str_corps_mail = "Pour validation du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " | Indice :" & str_indice &
" | Numéro d'identification :" & str_symbole & str_nidentite & " |
Libellé :" & str_libelle
str_corps_mail = str_corps_mail & Chr(10) & Chr(13)
str_corps_mail = str_corps_mail & "Modification effectuée sur
le document :" & str_modi_effectue
Dim OutlookApp As New Outlook.Application
Dim NewMail As Outlook.MailItem

Set NewMail = OutlookApp.CreateItem(olMailItem)
NewMail.To = str_rs
NewMail.Subject = "Pour validation du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " Indice:" & str_indice & "
du " & Date
NewMail.Body = str_corps_mail
NewMail.VotingOptions = "Approuvé;Refusé"
NewMail.Display
Dim MaBase As Database, rst As Recordset
Set MaBase = CurrentDb
Set JeuEnregistrement = MaBase.OpenRecordset("tbl_appobation")
With JeuEnregistrement
.AddNew
![str_refdoc] = str_refdoc
![str_indice] = str_indice
![d_dateenvois] = Date
![str_iduser_demandeur] = lpUserName
![str_idposte_demandeur] = NomPC
![str_type_envois] = "Validation"
![str_demander_a] = str_rs
.Update
End With
MaBase.Close
MsgBox "La demande de validation est envoyée, la confirmation
est inscrite dans la table de suivis.", vbInformation + vbOKOnly,
"Suivis des envois"
Dim bds As Database
Dim chSQL As String
' Retourne une référence à la base de données en cours.
Set bds = CurrentDb
chSQL = "UPDATE [suivis des indices] SET str_etat_validation =
'Validation' " _
& "WHERE [Indice] = '" & str_indice & "' AND [Ref
doc]= '" & str_refdoc & "'"
' Exécute la requête.action

bds.Execute chSQL
Set bds = Nothing

End Function
Function envoieconfirmation()
'""""""""""""""""""""""""""""
'On recherche le type de document à envoyer
Dim str_libelle_type_doc As String
'construction du critère de recherche du type de document
Dim str_critere_recherche_doc As String
Dim str_extrait_chaine
str_extrait_chaine = Mid(str_refdoc, 3, 2)
str_critere_recherche_doc = "[str_abrege]= '" & str_extrait_chaine & "'"
str_libelle_type_doc = DLookup("[str_libelle_doc]", "tbl_abreviation",
str_critere_recherche_doc)
'"""""""""""""""""""""""""""""""""""""""""""
'On récupère le nom user et le nom machine
' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
MsgBox "Unable to get the name."
End
End If

Dim lngLongueur As Long
Dim strTampon As String
Dim intR As Integer
strTampon = Space(255)
lngLongueur = Len(strTampon)
intR = GetComputerName(strTampon, lngLongueur)
NomPC = Left(strTampon, lngLongueur)
'envoyer un mail de confirmation

'MsgBox "'" & str_rs & "'"
str_corps_mail = "Pour approbation du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " | Indice :" & str_indice &
" | Numéro d'identification :" & str_symbole & str_nidentite & " |
Libellé :" & str_libelle
str_corps_mail = str_corps_mail & Chr(10) & Chr(13)
str_corps_mail = str_corps_mail & "Modification effectuée
sur le document :" & str_modi_effectue
Dim OutlookApp As New Outlook.Application
Dim NewMail As Outlook.MailItem

Set NewMail = OutlookApp.CreateItem(olMailItem)
NewMail.To = str_rs_approbation
NewMail.Subject = "Pour approbation du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " Indice:" & str_indice & "
du " & Date
NewMail.Body = str_corps_mail
NewMail.VotingOptions = "Approuvé;Refusé"
NewMail.Display
Dim MaBase As Database, rst As Recordset
Set MaBase = CurrentDb
Set JeuEnregistrement = MaBase.OpenRecordset("tbl_appobation")
With JeuEnregistrement
.AddNew
![str_refdoc] = str_refdoc
![str_indice] = str_indice
![d_dateenvois] = Date
![str_iduser_demandeur] = lpUserName
![str_idposte_demandeur] = NomPC
![str_type_envois] = "Approbation"
![str_demander_a] = str_rs_approbation
.Update
End With
MaBase.Close
MsgBox "La demande d'approbation est envoyée, la
confirmation est inscrite dans la table de suivis.", vbInformation +
vbOKOnly, "Suivis des envois"
Dim bds As Database
Dim chSQL As String
' Retourne une référence à la base de données en cours.
Set bds = CurrentDb
chSQL = "UPDATE [suivis des indices] SET str_etat_validation =
'Approbation' " _
& "WHERE [Indice] = '" & str_indice & "' AND [Ref
doc]= '" & str_refdoc & "'"
' Exécute la requête.action
'MsgBox chSQL


bds.Execute chSQL
Set bds = Nothing
End Function
Function envoiediffusion()
'""""""""""""""""""""""""""""
'On recherche le type de document à envoyer
Dim str_libelle_type_doc As String
'construction du critère de recherche du type de document
Dim str_critere_recherche_doc As String
Dim str_extrait_chaine
str_extrait_chaine = Mid(str_refdoc, 3, 2)
str_critere_recherche_doc = "[str_abrege]= '" & str_extrait_chaine & "'"
str_libelle_type_doc = DLookup("[str_libelle_doc]", "tbl_abreviation",
str_critere_recherche_doc)
'"""""""""""""""""""""""""""""""""""""""""""
'On récupère le nom user et le nom machine
' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
MsgBox "Unable to get the name."
End
End If

Dim lngLongueur As Long
Dim strTampon As String
Dim intR As Integer
strTampon = Space(255)
lngLongueur = Len(strTampon)
intR = GetComputerName(strTampon, lngLongueur)
NomPC = Left(strTampon, lngLongueur)
'envoyer un mail de confirmation

'MsgBox "'" & str_rs & "'"
str_corps_mail = "Pour diffusion du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " | Indice :" & str_indice &
" | Numéro d'identification :" & str_symbole & str_nidentite & " |
Libellé :" & str_libelle
str_corps_mail = str_corps_mail & Chr(10) & Chr(13)
str_corps_mail = str_corps_mail & "Modification effectuée sur
le document :" & str_modi_effectue
Dim OutlookApp As New Outlook.Application
Dim NewMail As Outlook.MailItem

Set NewMail = OutlookApp.CreateItem(olMailItem)
NewMail.To = str_rs
NewMail.Subject = "Pour diffusion du/de la " &
str_libelle_type_doc & " :" & str_refdoc & " Indice:" & str_indice & "
du " & Date
NewMail.Body = str_corps_mail

NewMail.Display
Dim MaBase As Database, rst As Recordset
Set MaBase = CurrentDb
Set JeuEnregistrement = MaBase.OpenRecordset("tbl_appobation")
With JeuEnregistrement
.AddNew
![str_refdoc] = str_refdoc
![str_indice] = str_indice
![d_dateenvois] = Date
![str_iduser_demandeur] = lpUserName
![str_idposte_demandeur] = NomPC
![str_type_envois] = "Diffusion"
![str_demander_a] = "Voir liste de diffusion"
.Update
End With
MaBase.Close
MsgBox "La diffusion est envoyée, la confirmation est inscrite
dans la table de suivis.", vbInformation + vbOKOnly, "Suivis des envois"
Dim bds As Database
Dim chSQL As String
' Retourne une référence à la base de données en cours.
Set bds = CurrentDb
chSQL = "UPDATE [suivis des indices] SET str_etat_validation =
'Diffusion' " _
& "WHERE [Indice] = '" & str_indice & "' AND [Ref
doc]= '" & str_refdoc & "'"
' Exécute la requête.action

bds.Execute chSQL
Set bds = Nothing
End Function

2 réponses

Avatar
3stone
Salut,

"Steph"
| J'ai un phénomène étrange.
| J'ai récupéré un code qui récupère l'utilisateur et le nom de PC.
| J'utilise ces données pour contrôler une base de
| gestion/validation/approbation de documents sous assurance qualité.
| Mais parfois, sans que ce soit reproductible, lorsque la séquence
| suivante s'exécute :
<snip>

Ce code est truffé de petites et grosses erreurs !!

Exemples:
Dim machin, chose as String
=> machin sera Variant et seul chose sera String...

Dim rst as Recordset
Set jeuenregistrement as Db.Openrecordset() ??

Oubli de libération des assignations...
set machin=Nothing

et d'autres...

On remarque que tu compile pas ton code et tu n'a pas fait
de débogage pas à pas.

Quant au changement de caractères... faudrait contrôler le bon
usage de l'utilisation des API (si c'est réellement lié à ce code)

--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
Conseils MPFA: http://www.mpfa.info/
Avatar
Steph
Bonjour,
Je pense bien que c'est loin d'être nickel....
Ce qui est étrange c'est que les erreurs ne se produisent que sur 1 poste
Mais je vais reprend tout ça depuis le début.
Merci.