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
Related
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?
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
I am very good using GNU/Linux, however on Windows I suck.
Making a dump of the local DB with mysqldump, compress the result, give it an incremental name and make it a cron task it's a very easy task for me.
But on Windows, I don't have a clue. I want to make a .bat script, or a windows script, with the task tool. Compress the result and give it a name wit the date in the PC. I using Wamp as server and I can't use GNU/Linux because my boss don't want it.
Google don't give me any good answer.
How can I do a good automated task for baking up with my desire characteristics on Windows 7 with Wamp?
Here is what i do.
I first run mysqldump to get .sql file using current date.
Next i run this script to compress it and move it into another folder. You can combine these two steps but i am posting here as a separate script to illustrate:
#echo off
set sourceDir=C:\mysql\mysqldump
set targetDir="C:\Users\Admin\Google Drive\mysql-backup"
#echo on
7z a %targetDir%\backup-%date:~-7,2%.7z %sourceDir%\backup-%date:~-7,2%.sql
#echo off
Be sure to have 7z program installed on your Windows computer.
At the end I do it myself in VBS:
Rem Plan de trabajo:
Rem 1. Dumpear la base de datos en un archivo.
Rem 2. Renombrar el archivo a uno con la fecha del dia en el nombre.
Rem 3. Comprimir el archivo con Compact
Rem 4. Borrar el archivo no comprimido.
Rem 5. Mover el archivo comprimido a la carpeta c:\Users\jvalenzuela\Documents\backups
Rem Lo que hace el script
Rem Le decimos que es un shell
Dim WshShell, oExec
Set WshShell = WScript.CreateObject("WScript.Shell")
Rem Agarramos la fecha
CurrentDate = Date
Rem Le damos formato a la fecha
Fecha = FormatDateTime(CurrentDate, vbShortDate)
Rem le decimos cual es el directorio de backup
BackupDir = "C:\Users\jvalenzuela\Documents\backups"
Rem Le damos la ubicación de mysqldump
MySQLDump = "C:\wamp\bin\mysql\mysql5.6.12\bin\mysqldump.exe"
Rem formateamos el nombre del respaldo
NombreDump = BackupDir & "\backup." & Fecha & ".sql"
Rem y le damos argumentos
MySqlDumpArguments = "-uroot --result-file=""" & NombreDump & """ --all-databases"
Rem Armamos el comando
comandoFinal = MySqlDump & " " & MySqlDumpArguments
Rem Y lo ejecutamos
set oExec = WshShell.Exec(comandoFinal)
Rem vemos si resultó el respaldo
if oExec.Status = 0 Then
WshShell.Run "compact /c " & NombreDump
Rem y si no resultó, lo registramos como error en el visosr de sucesos
Else
WshShell.LogEvent 1, "No se relizó el respaldo de base de datos del día"
End If
Rem este script no tiene poderes de super vaca
And add it to the tasks scheduler. Have fun!
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