I trying to run this code:
Dim jsonString, jsonDictionary
jsonString = "{ ""name"": ""John"", ""age"": 30, ""city"": ""New York"" }"
Set jsonDictionary = JSONToDictionary(jsonString)
MsgBox(jsonDictionary.Item("name")) ' -> "John"
MsgBox(jsonDictionary.Item("age")) ' -> 30
MsgBox(jsonDictionary.Item("city")) ' -> "New York"
Function JSONToDictionary(jsonString)
' Crea un objeto de script
Set jsonObject = CreateObject("ScriptControl")
' Establece la sintaxis JSON como el lenguaje de script
jsonObject.Language = "JScript"
' Utiliza el método eval() del objeto de script para parsear la cadena JSON
Set jsonDictionary = eval("(" + jsonString + ")")
' Devuelve el objeto diccionario
JSONToDictionary = jsonDictionary
End Function
But I get the error: "The ActiveX component can't create the object: 'ScriptControl' ".
Also I get the error: "System: This operation is not supported with BTT enabled".
I've tried everything but it doesn't work, would you know how to fix it?
Related
Closed. This question is not written in English. It is not currently accepting answers.
Stack Overflow is an English-only site. The author must be able to communicate in English to understand and engage with any comments and/or answers their question receives. Don't translate this post for the author; machine translations can be inaccurate, and even human translations can alter the intended meaning of the post.
Closed 5 days ago.
Improve this question
Al usar la funcion LoadPicture(ruta + nombre imagen) para cargar una imagen en un control de imagen dentro de un formulario, muestra un error que dice: la función LoadPicture no está definida.
Intento cargar una imagen jpg pero tan pronto inicia el sub genera el error, estoy trabajando con VMware Fusion desde una mac.
posteriormente la idea es guardar la imagen en una hoja Excel cuando el usuario haga click en el botón guardar.
Este es mi sub:
Private Sub Buscar_imagen_Click()
Dim ruta As String
Dim Nom_image As String
If trim$(NombreProducto) <> "" And trim$(NombreReferencia.Value) <> "" Then
Nom_image = "'" & trim$(NombreProducto) & "_" & trim(NombreReferencia.Value) & "'"
RutaImagen = ActiveWorkbook.Path & Application.PathSeparator & "Imagenes_Producto" & Application.PathSeparator & Nom_image & ".Jpg"
ControlProductos.Image_fotomochila = LoadPicture(ruta)
Else
MsgBox ("Para el nombre del producto ingreso no existe imagen")
End If
End Sub
I have a stored procedure in oracle getspname which I will receive 2 input parameters (varchar2 and number) and one output param of cursor type.
The application that is executing this stored procedure is a bit old, it is using VB6 in IIS6 to connect to this SP in ORACLE and I am migrating it to IIS7.
Provider=MSDAORA.1;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX
and SQL is:
{call schema.Pkg_name.getspname(?,?,{resultset 0, io_cursor})}
Params: 11111111;0
IN IIS6 has no problem executing the procedure and returning the cursor data,
in IIS7 if not, it sent input parameters, this also works, but I need to send it these fields to comply with the applied business logic.
This solution was also implemented but the error is replicated in SP that has only input or output parameters of type varchar2 stackoverflow.com/a/50643323/5904375
VB6:
Public Function execProcedure( _
ByVal sConnString As String, _
ByVal sSQL As String, _
ByRef oRs As Variant, _
ByVal sParameters As Variant, _
ByRef vntRespuesta As Variant, _
Optional Encrypt As Boolean _
) As Integer
Dim Params, i
Dim RsCmd
Dim oRecordSet
Dim RspMsg As Variant
Dim RspMsg1 As Variant
Dim RspMsg2 As Variant
Dim oConec
Dim BeforeConn As Boolean
Dim auxErr As Integer
Dim auxValue As Variant
Dim StringReg As Variant
Dim oEncrypt
Dim bEncrypt As Boolean
On Error GoTo Error_handler
'** Se verifica encriptacion del string de conexion
bEncrypt = False
If Not IsMissing(Encrypt) Then
If Encrypt Then bEncrypt = True
End If
If bEncrypt Then
Set oEncrypt = CreateObject("NR_DBconn.Encrypt")
StringReg = oEncrypt.EncriptarChrTran("azv", sConnString, 2)
Set oEncrypt = Nothing
Else
StringReg = sConnString
End If
BeforeConn = True
Set ctxObject = GetObjectContext
strNombreObjeto = "ADODB.Command"
Set RsCmd = ctxObject.CreateInstance("ADODB.Command")
'Set RsCmd = CreateObject("ADODB.Command")
strNombreObjeto = "ADODB.Recordset"
Set oRecordSet = ctxObject.CreateInstance("ADODB.Recordset")
'Set oRecordSet = CreateObject("ADODB.Recordset")
strNombreObjeto = "ADODB.Connection"
Set oConec = ctxObject.CreateInstance("ADODB.Connection")
'Set oConec = CreateObject("ADODB.Connection")
'*
'* Verifica si el sSQL es válido
'*
If sSQL = "" Or Len(sSQL) = 0 Then
ctxObject.SetAbort
'La transaccion finaliza con error
Err.Raise INSTRUCCION_INVALID, "Verificar sSQL"
End If
'*
'* Se verifica string de conexión
'*
If (StringReg = "") Then
ctxObject.SetAbort
'La transaccion finaliza con error
Err.Raise INSTRUCCION_INVALID, "Verificar string de Conexion"
End If
BeforeConn = False
oConec.Open StringReg
With RsCmd
.ActiveConnection = oConec
.CommandText = sSQL
.CommandType = adCmdText ' adCmdStoredProc 'adCmdText
If Len(sParameters) <> 0 Then
Params = Split(sParameters, ";")
For i = 0 To UBound(Params)
.Parameters(i).Direction = adParamInput
.Parameters(i).Value = Params(i)
Next i
End If
End With
oRecordSet.CursorLocation = adUseClient
oRecordSet.CursorType = adOpenStatic
oRecordSet.LockType = eltBatchOptimistic
Set oRecordSet = RsCmd.Execute()
'*
'* Verifica el resultado
'*
auxErr = -1
If oRecordSet.State = 1 Then
If oRecordSet.EOF Or oRecordSet.BOF Or oRecordSet Is Nothing Then
RspMsg1 = "0"
RspMsg2 = "No se obtuvo recordset de vntRespuesta - warning"
RspMsg = "[" & RspMsg1 & "]: " & RspMsg2
auxErr = 0
Set oRs = Nothing
Else
RspMsg1 = "0"
RspMsg2 = ""
RspMsg = "" '"[" & RspMsg1 & "]: " & RspMsg2
'------traspasa el recordsetresult a recordset desconectado
Dim Rsx
Dim j
Dim NumFields
Set Rsx = New ADODB.Recordset
NumFields = oRecordSet.Fields.Count - 1
With Rsx
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = eltBatchOptimistic
Set .ActiveConnection = Nothing
For i = 0 To NumFields
With .Fields
.Append oRecordSet.Fields(i).Name, adBSTR
End With
Next i
.Open
Do While Not oRecordSet.EOF
.AddNew
For j = 0 To NumFields
auxValue = oRecordSet.Fields(j)
.Fields(j) = CheckNull(auxValue)
Next j
oRecordSet.MoveNext
Loop
.MoveFirst
End With
'-------------
Set oRs = Rsx
'Set oRecordSet.ActiveConnection = Nothing
Set oRecordSet = Nothing
Set Rsx = Nothing
auxErr = 1
End If
Else
RspMsg1 = "2"
RspMsg2 = "No se obtuvo recordset de vntRespuesta - operacion no necesita"
RspMsg = "[" & RspMsg1 & "]: " & RspMsg2
auxErr = 2
Set oRs = Nothing
End If
vntRespuesta = RspMsg
Set RsCmd = Nothing
oConec.Close
Set oConec = Nothing
' If IsObject(oRs) Then
' execProcedure = oRs.RecordCount
' Else
execProcedure = auxErr
' End If
'*
'* La transacción finaliza exitosamente
ctxObject.SetComplete
Exit Function
Error_handler:
execProcedure = -1
RspMsg = ErrorMessage("SQLserver.execProcedure.", Err.Number, Err.Source, Err.Description, sSQL)
'*
'* Fin de la función, ha ocurrido un Error Fatal
'*
On Error Resume Next
If Not BeforeConn Then
If (oConec.State = adStateOpen) Then
oConec.Close
End If
End If
Set oConec = Nothing
vntRespuesta = RspMsg
'*
'* La transacción finaliza con error
'*
ctxObject.SetAbort
End Function
Function Error VB6:
Private Function ErrorMessage(ErrPath, ErrCod, ErrSource, ErrDescription, sSQL)
Dim RspMsg1
Dim RspMsg2
Dim strPathError
strPathError = "[" & ErrPath & "." & Err.Source & "] "
Select Case (ErrCod)
Case INSTRUCCION_INVALID
RspMsg1 = INSTRUCCION_INVALID
RspMsg2 = strPathError & " El string 'sSQL' esta mal formado." & _
"Verifique que el String 'sSQL' esté de acuerdo al formato SQL"
Case STRING_CONNECTION
RspMsg1 = STRING_CONNECTION
RspMsg2 = strPathError & "No existe string de conexion para esta Aplicacion "
Case NOT_REC_RETURN
RspMsg1 = NOT_REC_RETURN
RspMsg2 = strPathError & "No se retornaron registros." & _
"Intente de nuevo o con otros valores en el 'sSQL'. Este error puede deberse a una falla en la conexion con la Base de Datos. (" & sSQL & ")"
Case NOT_REC_FOUND
RspMsg1 = NOT_REC_FOUND
RspMsg2 = strPathError & "No se encontro registros." & _
"Intente con otros valores en la 'sSQL'. (" & sSQL & ")"
Case 429:
RspMsg1 = "-1"
RspMsg2 = strPathError & " No se puede crear el componente: '" & strNombreObjeto & _
"Verifique que el componente esté instalado correctamente."
'Error manipulado. En parametros de la base de datos.
Case -2147217887
RspMsg1 = "-1"
RspMsg2 = strPathError & "Error al insertar campo." & _
"Verifique el largo del valor del campo no exceda al maximo permitido en la definicion de la TABLA de la Base de Datos."
Case Else 'Cualquier otro tipo de Error
RspMsg1 = "-1"
RspMsg2 = strPathError & ErrDescription
End Select
ErrorMessage = "[" & RspMsg1 & "]: " & RspMsg2
End Function
This SP was also independently tested to rule out any problem, it works correctly
SP ORACLE:
PROCEDURE getspname (value IN varchar2 ,value2 IN number , io_cursor IN OUT t_cursor)
AS
BEGIN
........
END;
END getspname;
I solved this on Friday 08/17/2020 at 3 AM,
I decided to make a call directly to the oracle SP from the ASP using provider (OraOLEDB.Oracle) and thus replicate the behavior, this was giving an error of "Run-time error 3001 Arguments Are Of The Wrong Type… when setting ADODB.Command object members"
The ASP code:
Name file: test.asp
<%# Language=VBScript %>
<%Response.Buffer = false%>
<%Response.Expires = 0%>
<%
Dim strConnect
strConnect = "Provider=OraOLEDB.Oracle;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX"
Dim cn, rs, cmd, param
set cn = Server.CreateObject( "ADODB.Connection" )
cn.Open Cstr(strConnect)
set cmd = server.CreateObject ("ADODB.Command")
with cmd
set .ActiveConnection = cn
.NamedParameters = True
.CommandText = "{call schema.Pkg_name.getspname({resultset 0, io_cursor})}"
.CommandType = 1
end with
set rs = server.CreateObject ( "ADODB.Recordset" )
set rs = cmd.execute
Set rs = cmd.Execute
Do Until rs.EOF
for each x in rs.fields
response.write(x.name)
response.write("=")
response.write(x.value)
response.write(", ")
next
response.write("<br />")
rs.MoveNext
Loop
rs.Close
%>
<%
Dim strConnect_cn
strConnect_cn = "Provider=OraOLEDB.Oracle;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX"
Dim cn_cn, rs_cn, cmd_cn , param1, param2
set cn_cn = Server.CreateObject( "ADODB.Connection" )
cn_cn.Open Cstr(strConnect_cn)
set cmd_cn = server.CreateObject ("ADODB.Command")
with cmd_cn
set .ActiveConnection = cn_cn
.CommandText = "{call schema.Pkg_name.getspname(?,?,{resultset 0, io_cursor})}"
.CommandType = 1
end with
cmd_cn.parameters.append(cmd_cn.createParameter("", adVariant, adParamInput, , "11111111"))
cmd_cn.parameters.append(cmd_cn.createParameter("", adVariant, adParamInput, , "0"))
set rs_cn = server.CreateObject ( "ADODB.Recordset" )
set rs_cn = cmd_cn.execute
Set rs_cn = cmd_cn.Execute
Do Until rs_cn.EOF
for each x in rs_cn.fields
response.write(x.name)
response.write("=")
response.write(x.value)
response.write(", ")
next
response.write("<br />")
rs_cn.MoveNext
Loop
rs_cn.Close
%>
<html>
<head>
<title> Links </title>
</head>
<body>
<p>test.asp</p>
</body>
</html>
This code throws me the following problem with input parameters, where the arguments were of the wrong type.
"Run-time error 3001 ‘Arguments Are Of The Wrong Type, Are Out Of The
Acceptable Range, or are in conflict with one another’ upon invocation
of"
And according to the documentation that I found this is fine
http://www-db.deis.unibo.it/courses/TW/DOCS/w3schools/asp/met_comm_createparameter.asp.html
https://welookups.com/asp/ado_datatypes.html
https://learn.microsoft.com/en-us/sql/ado/reference/ado-api/datatypeenum?view=sql-server-ver15
After much searching in forums on the Internet I found that the following article:
http://keencod.in/?p=23
This explains:
...that error is fired because of late binding of library references,
so VB simply did not know of adCmdStoredProc and other constants. That
meant that this error has nothing to do with ADODB or Ole or SP...
Therefore, you only had to declare these values at the beginning as constants, just as explained in the article.
So at the beginning of my ASP (test.asp) code add:
Const adVarChar = 200
Const adParamInput = &H1
Const adParamOutput = &H2
Const adCmdStoredProc = &H4
Const adVariant = 12
And magic, it worked!!
Then I modified my VB6 code, which was the one I had to use to comply with the business logic of the applications that were being migrated.
At the beginning of the file add:
Const adVarChar As Long = 200
Const adParamInput As Long = &H1
Const adParamOutput As Long = &H2
Const adCmdStoredProc As Long = &H4
Const adCmdText As Long = 1
Const adUseClient As Long = 3
Const adOpenStatic As Long = 3
Const adVariant As Long = 12
And then change my VB6 code like this:
With RsCmd
.ActiveConnection = oConec
.CommandText = sSQL
.CommandType = adCmdText ' adCmdStoredProc 'adCmdText
If Len(sParameters) <> 0 Then
.NamedParameters = True
Params = Split(sParameters, ";")
For i = 0 To UBound(Params)
.Parameters.Append (.CreateParameter("", adVariant, adParamInput, , Params(i)))
Next i
End If
End With
Using provider: MSDAORA.1
And with this the problem was solved!!
This is my story, thank you very much!!
End.
I'm using PowerDesigner v16 and I created an Extension; in this Extension a MetaClass of the Table type was added; in this MetaClass an Event Handler was created, using VBScript, to go through all the tables and create some fields / columns (attributes) default in all tables.
But now I want to take advantage of that I'm going through all the tables and also through VBScript to create a standard Trigger that is in TriggerTemplate, and I don´t know how to do this through VBScript.
My main question is: how to create a Trigger using VBScript and assign a TriggerTemplate?
Can you provide me with an example?
Possibly related question:
PowerDesigner - Assign a TriggerTemplate to a trigger through VBScript?
Below is the function I use to go through the entire table and check if there are standard columns:
Note: This function is performed in a PowerDesigner Extencion using PDM modeling. And the path of this extension is as follows: DEFAULT COLUMNS::Profile\Table\Event Handlers\Initialize
'******************************************************************************
' Função para checar se a coluna já existe na tabela.
'******************************************************************************
function ColumnExists(tab, name)
'output "ClassName: " + tab.ClassName
'Checa se a o objeto passano no parâmetro "tab" é do tipo Table (tabela)
if tab.ClassName = "Table" then
dim col
'Passa por todas as colunas da tabela
for each col in tab.Columns
'Checa se o nome da coluna atual já existe igual ao passado por parâmetro ("name")
if col.Name = name then
'output "... já existe " + col.Name
ColumnExists = true
exit function
end if
next
end if
ColumnExists = false
end function
'******************************************************************************
' Função responsável por criar as colunas padrao de uma tabela.
'******************************************************************************
Sub DoCreateColumns(tab)
' Checa se o objeto passado no parâmetro ("tab") é do tipo "Table"
if not tab.ClassName = "Table" then exit sub
dim c
dim myColumns, column
' Executa função "DefaultColumns()" serve para criar um array com todas as colunas padrão
myColumns = DefaultColumns()
'Passa por todas as colunas salvas'
for each column in myColumns
'Checa se esta coluna é um ID
if column.Name = "ID_" then
' Adiciona o nome da tabela junto com a palavra ID
column.Name = "ID_" + tab.Name
column.Code = column.Name
end if
'Checa se a coluna ja existe
if not ColumnExists(tab, column.Name) then
set c = tab.Columns.CreateNewAt(column.Position)
c.Name = column.Name
c.Code = column.Code
c.domain = column.Domain
c.Mandatory = column.Mandatory
output "... adding column " + column.Name + " table " + tab.Name
end if
next
End Sub
I created a SAP SQL Anywhere 17 PDM with one table, saved it as a .pdm file; then added a trigger based on a template on this table, and saved the model as a new .pdm file. By comparing the files, I get some hints of the representation of triggers + templates.
Especially that the trigger template is attached to the trigger. Through a shortcut, as the template is in the DBMS while the trigger is in the model.
<o:Table Id="o9">
<a:Name>Table_1</a:Name>
<a:Code>TABLE_1</a:Code>
<c:Triggers>
<o:Trigger Id="o10">
<a:Name>Trigger_1</a:Name>
<a:Code>TRIGGER_1</a:Code>
<c:BaseTrigger.TriggerItems>
<o:Shortcut Ref="o5"/>
<o:Shortcut Ref="o6"/>
</c:BaseTrigger.TriggerItems>
<c:TriggerTemplate> <===
<o:Shortcut Ref="o4"/> <===
</c:TriggerTemplate>
</o:Trigger>
</c:Triggers>
Looking at the help file SAP PowerDesigner 16 OLE Help, I see the TriggerTemplate as a property of the BaseTrigger class, from which Trigger is derived.
Here is an example which uses that.
option explicit
' create model
dim mdl : set mdl = CreateModel(PDPdm.cls_PdmModel, "|DBMS=SAP SQL Anywhere 17")
' create table and trigger
dim tbl : set tbl = mdl.CreateObject(PDPdm.cls_Table)
dim trig : set trig = tbl.CreateObject(PDPdm.cls_Trigger)
' set trigger template
SetTemplate trig, "BeforeUpdateTrigger"
function SetTemplate(trg, typ)
SetTemplate = false
' find template
dim db : set db = trg.Model.DBMS
' in case of shared DBMS instead of embedded one
if db.IsShortcut() then set db = db.TargetObject
dim tm, found
for each tm in db.TriggerTemplates
if tm.name = typ then
set found = tm
exit for
end if
next
if IsEmpty(found) then exit function
' create shortcut alongside the table
dim fld : set fld = trg.Parent.Folder
dim short : set short = found.CreateShortcut(fld)
' assign, and initialize
set trg.TriggerTemplate = short
trg.InitFromTemplate
SetTemplate = true
end function
I have the following script to add signature in Outlook:
...
Set objShape = objSelection.InlineShapes.AddPicture("\\blabla\blabla\blabla\blabla\blabla\" & strlogin2 & ".jpg")
url = "http://url.com.mx/assets/aviso.pdf"
objSelection.Font.Italic = True
objSelection.Font.Size = 09
objSelection.TypeText "El Aviso de Privacidad de XXXXXX, está disponible en "
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, url)
objSelection.TypeText ", es aplicable a todos los Titulares de Datos Personales obtenidos por la Empresa, a través de cualquier medio físico o electrónico y para los fines que se hace referencia en el mismo."
objSelection.Font.Color = RGB(255, 102, 0)
objLink.Range.Font.Name = "Calibri"
objLink.Range.Font.Size = 09
objLink.Range.Font.Bold = True
objSelection.Font.Bold = True
objSelection.Font.Color = RGB(105, 105, 105)
objSelection.Font.Color = RGB(105, 105, 105)
objSelection.TypeParagraph()
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Firma Corporativa XXXX", objSelection
objSignatureObject.NewMessageSignature = "Firma Corporativa XXXXXX"
objSignatureObject.ReplyMessageSignature = "Firma Corporativa XXXXX"
objDoc.Saved = True
objWord.Quit
This is the result:
I need set a line break between the image and text.
Type a paragraph after you inserted the image:
Set objShape = objSelection.InlineShapes.AddPicture(...)
objSelection.TypeParagraph
That's my first time posting on stackoverflow. I've been finding usefull answers on this site but this time, I can't find no help with this problem.
General context
I wrote a VBScript Toolkit script (S:\Universe_bo\prod\batch\BO\libs\PXI_Toolkit.vbs) included in scripts (S:\Universe_bo\prod\batch\BO*.wsf) that are executed by a scheduler software.
The system is a Windows Server 2003 server (this server is part of an active-passive Windows cluster and the S: drive is a resource of this cluster). The Windows user running the scripts has permission to write in the directory and is an Administrator.
In the scripts, I open a new file and write some text in it (it is the content of an e-mail).
The problem
Here is what happens (today, it crashed 7 out of 10 times):
(---) [24/03/2012 10:34:23] Ouverture du fichier [S:\universe_bo\prod\data\email_rad98038.tmp]
S:\universe_bo\prod\batch\BO\BOLANC_BOAPP500_TOP100.wsf(2451, 8) Erreur d'exécution Microsoft VBScript: Permission refusée
It means "Runtime error Microsoft VBScript: Permission denied".
The line 2451 from the script is the following:
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
We have been using them for two years without a problem on the test server (not a cluster) but now that it finally passed production, it doesn't work all the time.
I have no idea what the problem could be, I'm all ears and will take any suggestion.
Thanks in advance.
Guillaume
Source scripts
.wsf script
The .wsf scripts look like this:
(I removed the irrelevant parts, and comments are in French since we are)
'===============================================================================
' BOLANC_BOAPP500_TOP100.wsf (script)
'===============================================================================
<job><?job debug="true"?>
<script language="VBScript" src="libs/PXI_Toolkit.vbs"/>
<script language="VBScript">
Dim codeRetour ' Le code retour du script
codeRetour = 0 ' est initialisé à 0 (tout va bien)
' [...]
' Irrelevant stuff
' [...]
' Exécuter le rapport
codeRetour = rapport.Executer
LibererRessources
Wscript.Quit codeRetour
</script>
</job>
Toolkit script
And here are the involved parts of the PXI_Toolkit.vbs script:
Option Explicit
'===============================================================================
' PXI_Toolkit.vbs (script)
'===============================================================================
'*******************************************************************************
' fso (objet)
' Scripting.FileSystemObject
'*******************************************************************************
dim fso
set fso = CreateObject("Scripting.FileSystemObject")
'*******************************************************************************
' Constantes pour l'ouverture des fichiers
'*******************************************************************************
Private Const ForReading = 1 ' Ouvre un fichier en lecture seule.
Private Const ForWriting = 2 ' Ouvre un fichier en écriture.
Private Const ForAppending = 8 ' Ouvre un fichier et permet l'écriture à la fin
' du fichier.
'*******************************************************************************
' WshShell (objet)
' Objet Permettant d'accéder aux fonctionnalités systèmes Windows.
'*******************************************************************************
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
'*******************************************************************************
' WshSysEnv (tableau de chaînes)
' Tableau contenant les variables d'environnements. WshSysEnv est indexé
' par le nom des variables qu'il contient.
' Exemple : Ecrire "Utilisateur="& WshSysEnv("USERNAME")
'*******************************************************************************
Dim WshSysEnv
Set WshSysEnv = WshShell.Environment("Process")
' Lots of stuff
'*******************************************************************************
' EcrireErr (procédure)
' Affiche un message d'erreur.
'
' Paramètres :
' - pstrMessage (chaîne)
' Message d'erreur à afficher.
'*******************************************************************************
Sub EcrireErr(pstrMessage)
WScript.stdErr.WriteLine "(!!!) ["& Now &"] "& Cstr(pstrMessage)
End Sub ' EcrireErr
'*******************************************************************************
' EcrireLog (procédure)
' Journalise un message dans les logs.
'
' Paramètres :
' - pstrChaine (chaîne)
' Texte à journaliser.
'*******************************************************************************
Sub EcrireLog(pstrChaine)
Ecrire "(---) ["& Now &"] "& Cstr(pstrChaine)
End Sub ' EcrireLog
'*******************************************************************************
' LibererRessources (procédure)
' Libère les ressources potentiellement ouvertes au cours de l'exécution
' des fonctions de ce script.
'
' Paramètres : Aucun
'*******************************************************************************
Sub LibererRessources()
EcrireLog "LibererRessources"
' Libérer les variables système
Set WshArguments = Nothing
Set WshSysEnv = Nothing
Set WshShell = Nothing
Set fso = Nothing
End Sub ' LibererRessources
Class ClsRapportBO
Private pvarrstrMessageEmail pvstrNomFichierCorpsEmail
Public Function Executer()
' Ecriture du fichier contenant le corps du mail
If Not IsEmpty(pvarrstrMessageEmail) Then
Dim objFichier, strLigne
EcrireLog "Ouverture du fichier ["& pvstrNomFichierCorpsEmail &"]"
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
' Ecriture de l'en-tête du message
objFichier.WriteLine "Bonjour"
objFichier.WriteLine
' Lecture des éléments du tableau construire le fichier
For Each strLigne In pvarrstrMessageEmail
objFichier.WriteLine strLigne
Next
' Ecriture du pied de page
objFichier.WriteLine
objFichier.WriteLine "NB : Ce message est envoyé automatiquement. "&_
"Merci de ne pas y répondre."
objFichier.Close
End If
' More stuff
If Not IsEmpty(pvarrstrMessageEmail) And fso.FileExists(pvstrNomFichierCorpsEmail) Then
EcrireLog "Suppression du fichier ["& pvstrNomFichierCorpsEmail &"]"
fso.DeleteFile(pvstrNomFichierCorpsEmail)
End If
End Function ' Executer
End Class ' ClsRapportBO
Function CreerRapportBO(pstrChemin, parrstrInvites, pstrToken)
Dim objRapport
Set objRapport = new ClsRapportBO
' ...
Set CreerRapportBO = objRapport
End Function ' CreerRapportBO
' Tests de la boîte à outils
Sub TestsUnitaires()
' Unit tests...
End Sub ' TestsUnitaires
Is "S:\universe_bo\prod\data\email_rad98038.tmp" a file created by the script, or a file created by another process? A likely cause of this problem is that the file is in use. You can wrap the statement with:
On Error Resume Next
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
On Error GoTo 0
If Not IsObject(objFichier) Then
...
More Logic Here
...
End If