I'm writing a script to help myself with my work and I've never coded with VBA before this. Actually, i wrote this (partially, got a couple functions from other macros) but i don't understand it perfectly.
So the script is supposed to get some values from the equation manager table, display them in a textbox and when the user presses Go the values are updated with the new input values. The values are being transformed from "4.5" to "45" in one of the input boxes
the code is
Attribute VB_Name = "Modulo"
Option Explicit
Dim swApp As SldWorks.SldWorks 'Declara Variavel da Aplicação
Dim swModel As SldWorks.ModelDoc2 'Declara Variavel do Modelo
Public Larg, Comp, Alt As Double 'Declara Variavel Publica para os valores atuais do Modelo
Public AltT, RaioT, QntdPrat As Double 'Declara variaveis para testeira e pirulito
Public EspessuraEstrutural As Double 'Declara Variaveis para Espessura
Public NLarg, NComp, NAlt As Double 'Declara Variavel Publica para os Novos Valores
Public NAltT, NRaioT, NQntdPrat As Double 'Declara Variaveis para Novos valores
Public NEspessuraEstrutural As Double 'Declara Variaveis para Novos valores
Public contadorDeParametros 'numero de parametros
Sub main()
Set swApp = Application.SldWorks 'Atribui A aplicação atual à variavel
Set swModel = swApp.ActiveDoc 'Atribui A Modelo atual à variavel
If Not swModel Is Nothing Then 'Checa se o modelo não está vazio
Dim swEqMgr As SldWorks.EquationMgr 'Declara Variavel para a tabela de equações
Set swEqMgr = swModel.GetEquationMgr 'Atribui a tabela de equações Para a Variavel
Comp = swEqMgr.value(1) 'Atribui o valor atual para a variavel
Larg = swEqMgr.value(0) 'Atribui o valor atual para a variavel
Alt = swEqMgr.value(2) 'Atribui o valor atual para a variavel
AltT = swEqMgr.value(10) 'Atribui o valor atual para a variavel
RaioT = swEqMgr.value(15) 'Atribui o valor atual para a variavel
EspessuraEstrutural = swEqMgr.value(3) 'Atribui o valor atual para a variavel
QntdPrat = swEqMgr.value(11)
UserForm1.TextComp.Text = Comp 'Exibe o valor atual na interface
UserForm1.TextLarg.Text = Larg 'Exibe o valor atual na interface
UserForm1.TextAlt.Text = Alt 'Exibe o valor atual na interface
UserForm1.TextAltT.Text = AltT 'Exibe o valor atual na interface
UserForm1.TextRaioT.Text = RaioT 'Exibe o valor atual na interface
UserForm1.TextEspessuraEstrutural.Text = EspessuraEstrutural 'Exibe o valor atual na interface
UserForm1.TextQntdPrat.Text = QntdPrat 'Exibe o valor atual na interface
End If
UserForm1.Show vbModeless 'Exibe a inteface com a opção de não travar o foco
End Sub
Public Sub AlteraEq() 'Função publica para alterar as dimensões se elas forem diferentes da dimensão original
Dim modelo As SldWorks.ModelDoc2 'Declara Variavel da Aplicação da funcao
Dim aplicacao As SldWorks.SldWorks 'Declara Variavel da Aplicação da funcao
Dim tabelaEQ As SldWorks.EquationMgr 'Declara Variavel da Aplicação da funcao
Set aplicacao = Application.SldWorks 'Atribui A aplicação atual à variavel da funcao
Set modelo = aplicacao.ActiveDoc 'Atribui o Modelo atual à variavel da funcao
Set tabelaEQ = modelo.GetEquationMgr 'Atribui A tabela de equações atual à variavel da funcao
NullCatch Comp, NComp, "Comprimento", tabelaEQ
NullCatch Larg, NLarg, "Largura", tabelaEQ
NullCatch Alt, NAlt, "Altura", tabelaEQ
NullCatch AltT, NAltT, "AlturaTesteira", tabelaEQ
NullCatch RaioT, NRaioT, "FilletTesteira", tabelaEQ
NullCatch EspessuraEstrutural, CStr(NEspessuraEstrutural), "EspessuraChapa", tabelaEQ
NullCatch QntdPrat, NQntdPrat, "QuantidadePrateleiras", tabelaEQ
End Sub
Sub NullCatch(valor, novoValor, Parametro As String, Tabela As SldWorks.EquationMgr)
If Not novoValor = valor Then 'Checa se O novo valor e o valor anterior são iguais
If SetEquationValue(Tabela, Parametro, CDbl(novoValor)) Then 'executa a função que altera a Tabela com os novos parametros
swModel.ForceRebuild3 True 'Força o modelo a ser reconstruido com os novos parametros
Else 'Senao
MsgBox "Failed to find the equation " & Parametro 'Exibe mensagem de erro
End If
End If
End Sub
Function SetEquationValue(eqMgr As SldWorks.EquationMgr, name As String, value As Double) As Boolean 'Funcao para alterar valor de uma equacao
Dim index As Integer 'Declara Variavel para index como integer
index = GetEquationIndexByName(eqMgr, name) 'Atribui o index da equacao usando o nome atraves de outra funcao
If index <> -1 Then 'Checa se o index é valido
eqMgr.Equation(index) = """" & name & """=" & value 'Altera o valor da equação
SetEquationValue = True 'Retorna Verdadeiro para a função
Else 'Senao
SetEquationValue = False 'Retorna falso para a função
End If
End Function
Function GetEquationIndexByName(eqMgr As SldWorks.EquationMgr, name As String) As Integer 'Funcao para obter index por nome
Dim i As Integer 'Declara uma variavel para usar no loop
GetEquationIndexByName = -1 'define o retorno da funcao para -1(valor invalido usado para sinalizar o fim da lista)
For i = 0 To eqMgr.GetCount - 1 'Loop que vai de 0 ao fim da lista de equações
Dim eqName As String 'Declara Variavel para o nome da equação atual do loop
eqName = Trim(Split(eqMgr.Equation(i), "=")(0)) 'remove tudo após o = na função
eqName = Mid(eqName, 2, Len(eqName) - 2) 'Remove os paranteses do nome
If UCase(eqName) = UCase(name) Then 'Compara o nome dado como parametro da função com o nome da equacao atual do loop
GetEquationIndexByName = i 'Se é igual retorna o valor do index para a função
Exit Function
End If
Next
End Function
And the code for the userform is
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1
Caption = "UserForm1"
ClientHeight = 4815
ClientLeft = 120
ClientTop = 465
ClientWidth = 4230
OleObjectBlob = "UserForm1.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Private Sub UserForm_Activate()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
End Sub
Public Sub Butao_Click()
Modulo.NComp = UserForm1.TextComp.Text
Modulo.NLarg = UserForm1.TextLarg.Text
Modulo.NAlt = UserForm1.TextAlt.Text
Modulo.NRaioT = UserForm1.TextRaioT.Text
Modulo.NAltT = UserForm1.TextAltT.Text
Modulo.NEspessuraEstrutural = UserForm1.TextEspessuraEstrutural.value
Modulo.NQntdPrat = UserForm1.TextQntdPrat.Text
Call Modulo.AlteraEq
UserForm1.Hide
End Sub
The var that is giving me trouble is the "EspessuraEstrutural" but all variables are set up the same so i don't know if this info is useful
Related
I have the following code and I get the following error:
Error 45 'MySqlCommandBuilder' is a type and cannot be used as an expression. C:\FactMype\Systems\gtpcomercialElectronic\gtperpcomercial\gtperpcomercial\libraries\vps\connectionvps.vb 87 13 gtperpcomercial.
Imports MySql.Data.MySqlClient
Imports MySql.Data
Imports System.Configuration
Imports System.Data
Imports System
Imports System.Reflection
Public Class conexionvps
Public prueba As String
Dim conexion As conexionvps
'CONEXION A MYSQL DATA PARA DESARROLLO DE SISTEMAS
'..procedure
'Protected Sub insert_generico(ByVal ParamArray parrParms() As Object)
' Try
' strNombreSP = prostrNombreTabla & "_insert"
'
' Sql.ExecutenonQuery(strNombreSP, parrParms)
' Catch ex As Exception
'
' Throw New System.Exception("Error en insert generico.", ex)
'
' End Try
'End Sub
Public Function creartablaproc(ByVal sql As String) As DataTable
Dim ds As New DataSet
Try
Dim vector() As String = Split(sql, "\")
Dim dap As MySqlDataAdapter = New MySqlDataAdapter(vector(0), conexionmysql)
dap.SelectCommand.CommandType = CommandType.StoredProcedure
If vector.Length > 1 Then
Dim contador As Integer
For contador = 1 To UBound(vector)
dap.SelectCommand.Parameters.Add(New MySqlParameter(vector(contador), vector(contador + 1)))
contador = contador + 2
dap.SelectCommand.Parameters(vector(contador - 2)).Value = vector(contador)
Next
End If
dap.Fill(ds)
Return ds.Tables(0)
Catch ex As Exception
MsgBox(ex.Message)
Return ds.Tables(0)
End Try
End Function
'-----------------------------------------------------------------------------------------------------------
'Obteniendo datos a lista, combos, grid
'Obteniendo datos a lista, combos, grid
'Function ObtenerDatos(ByVal cadena As String) As DataTable
' Dim myDataSet As DataTable = New DataTable
' conexion = New Conexion()
' Dim conect As New MySqlConnection(conexion.conexionmysql)
' conect.Open()
' Dim adapter As New MySqlDataAdapter()
' adapter.SelectCommand = New MySqlCommand(cadena, conect)
' adapter.Fill(myDataSet)
' ObtenerDatos = myDataSet
' conect.Close()
'End Function
' Actualizar datos directamente del grid pero con un button
Public Sub actualizargrid(ByVal consulta As String)
Try
Dim bidings As New BindingSource
Dim cobertura As New DataTable()
'Dim adaptador As System.Data.Odbc.OdbcDataAdapter
Dim adaptador As New MySqlDataAdapter()
adaptador.Update(CType(bidings.DataSource, DataTable))
adaptador = New MySqlDataAdapter(consulta, conexionmysql)
Dim commandbuilder As New MySqlCommandBuilder(adaptador)
adaptador.Fill(cobertura)
bidings.DataSource = cobertura
Catch ex As MySqlException
MessageBox.Show("Excepcion al leer los datos:" + ex.Message)
End Try
End Sub
Public Sub actualizargridprueba(ByVal consulta As String)
Try
Dim adapter As New MySqlDataAdapter()
MySqlCommandBuilder cd = New MySqlCommandBuilder(adapter)
Catch ex As MySqlException
MessageBox.Show("Excepcion al leer los datos:" + ex.Message)
End Try
End Sub
'Cadena de conexion en mysql
Public Function conexionmysql() As String
Dim CAD As String
Dim servergsoft As String = "gtpsoft.com" 'ConfigurationManager.AppSettings("servergsoft").ToString()
Dim puertobd As String = "3306" 'ConfigurationManager.AppSettings("puertobd").ToString()
Dim usuariobd As String = "gtpsoft" 'ConfigurationManager.AppSettings("usuariobd").ToString()
Dim clavebd As String = "asdfd9i#Bpy" 'ConfigurationManager.AppSettings("clavebd").ToString()
Dim gsoftbd As String = "gtpsoft_seda" 'ConfigurationManager.AppSettings("gsoftbd").ToString()
CAD = "Database=" + gsoftbd + ";Data Source=" + servergsoft + ";User Id=" + usuariobd + ";Password=" + clavebd + ";Pooling=false;Connection Lifetime=1; Max Pool Size=1; Port=" + puertobd + "; default command timeout=40000; Convert Zero Datetime=True"
conexionmysql = CAD
End Function
' Funciones No Probadas
' retorna el numero de registro en mysql
Private Function numeroRegistrosConsulta(ByVal dr As MySqlDataReader) As Integer
Dim numeroRegistros As Integer = 0
Do While dr.Read
numeroRegistros = numeroRegistros + 1
Loop
numeroRegistrosConsulta = numeroRegistros
End Function
' consulta para generar en red
Public errortransaccion As Integer ' si es 0 todo correcto, si es 1 todo incorrecto
Public Sub Consultamysql_transaccion(ByRef Consultas As String)
Try
errortransaccion = 0
Dim i As Integer
Dim Conexion_mysql As MySqlConnection = New MySqlConnection(conexionmysql())
Conexion_mysql.Open()
Dim transaccion As MySqlTransaction
Dim comando As MySqlCommand
'Crear un arreglo de memoria y cargar en cada vector las consultas separadas por punto y coma
Dim Array_Consultas() As String
Array_Consultas = Split(Consultas, ";")
transaccion = Conexion_mysql.BeginTransaction
For i = LBound(Array_Consultas) To UBound(Array_Consultas) - 1
comando = New MySqlCommand(Array_Consultas(i), Conexion_mysql)
comando.Transaction = transaccion
comando.ExecuteNonQuery()
Next
transaccion.Commit()
' transaccion.Rollback()
Conexion_mysql.Close()
'MsgBox("Transacción Finalizada con Exito!", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Transacción Procesada")
Catch ex As MySqlException
errortransaccion = 1
MsgBox("No se pudo ejecutar la transacción!", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "Error en la transacción")
'MsgBox(ex.ToString, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Detalles del error")
End Try
End Sub
Public Sub Consultamysql_transacciongeneral(ByRef Consultas As String)
Try
errortransaccion = 0
Dim i As Integer
Dim Conexion_mysql As MySqlConnection = New MySqlConnection(conexionmysql())
Conexion_mysql.Open()
Dim transaccion As MySqlTransaction
Dim comando As MySqlCommand
'Crear un arreglo de memoria y cargar en cada vector las consultas separadas por punto y coma
Dim Array_Consultas() As String
Array_Consultas = Split(Consultas, ";")
transaccion = Conexion_mysql.BeginTransaction
For i = LBound(Array_Consultas) To UBound(Array_Consultas) - 1
comando = New MySqlCommand(Array_Consultas(i), Conexion_mysql)
comando.Transaction = transaccion
comando.ExecuteNonQuery()
Next
transaccion.Commit()
' transaccion.Rollback()
Conexion_mysql.Close()
'MsgBox("Transacción Finalizada con Exito!", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "Transacción Procesada")
Catch ex As MySqlException
errortransaccion = 1
'MsgBox("No se pudo ejecutar la transacción!", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "Error en la transacción")
'MsgBox(ex.ToString, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Detalles del error")
End Try
End Sub
Public cruderror As Integer
Public Sub consultacrudmysql(ByRef Consultas As String, ByVal tabla As String)
Try
errortransaccion = 0
Dim i As Integer
Dim Conexion_mysql As MySqlConnection = New MySqlConnection(conexionmysql())
Conexion_mysql.Open()
Dim transaccion As MySqlTransaction
Dim comando As MySqlCommand
'Crear un arreglo de memoria y cargar en cada vector las consultas separadas por punto y coma
Dim Array_Consultas() As String
Array_Consultas = Split(Consultas, ";")
transaccion = Conexion_mysql.BeginTransaction
For i = LBound(Array_Consultas) To UBound(Array_Consultas) - 1
comando = New MySqlCommand(Array_Consultas(i), Conexion_mysql)
comando.Transaction = transaccion
comando.ExecuteNonQuery()
Next
transaccion.Commit()
' transaccion.Rollback()
Conexion_mysql.Close()
MsgBox("OPERACION EXITOSA", MsgBoxStyle.Exclamation, "SISTEMA")
Catch ex As MySqlException
errortransaccion = 1
MsgBox(tabla + " " + "YA EXISTE", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "VALIDACION")
'Exit Sub
'MsgBox(ex.ToString, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Detalles del error")
End Try
End Sub
' leer datos
Public Sub leerdato(ByVal consulta As String)
Dim myConnection As New MySqlConnection(conexion.conexionmysql)
Dim myCommand As New MySqlCommand(consulta, myConnection)
myConnection.Open()
Dim myReader As MySqlDataReader
myReader = myCommand.ExecuteScalar()
myReader.Close()
myConnection.Close()
End Sub
'obtener solo un valor en especifico sin cargar a grid directo a la variable
Public Function ValorDato(ByVal Tabla As String, ByVal MiSelect As String)
Dim Valor As String = ""
Try
Dim myConnection As New MySqlConnection(conexionmysql())
myConnection.Open()
Dim Cmd As New MySqlCommand(MiSelect, myConnection)
Dim Da As New MySqlDataAdapter(Cmd)
Dim Ds As New DataSet
Dim cont As Integer
Da.Fill(Ds, Tabla)
cont = Ds.Tables(Tabla).Rows.Count
If cont = 0 Then
Valor = ""
Else
Valor = Ds.Tables(Tabla).Rows(0).Item(0).ToString
End If
Return Valor
Catch ex As Exception
'MsgBox(ex.Message)
Return Valor
End Try
End Function
Public Function retornarstring(ByVal Tabla As String)
Try
Dim cm As MySqlCommand
Dim myConnection As New MySqlConnection(conexionmysql())
Dim x As String
myConnection.Open()
cm = New MySqlCommand(Tabla)
'La consulta de la línea anterior debe devolver únicamente un registro
cm.Connection = myConnection
If cm.ExecuteScalar() Is DBNull.Value Then
x = "0"
Else
x = cm.ExecuteScalar()
End If
retornarstring = x
Catch ex As Exception
'MsgBox("ERROR INESPERADO, RETORNAR STRING", MsgBoxStyle.Information, "ERP")
retornarstring = "0"
End Try
End Function
Public Function ValorNumero(ByVal Tabla As String, ByVal MiSelect As String)
Dim Valor As String = "0"
Try
Dim myConnection As New MySqlConnection(conexionmysql())
myConnection.Open()
Dim Cmd As New MySqlCommand(MiSelect, myConnection)
Dim Da As New MySqlDataAdapter(Cmd)
Dim Ds As New DataSet
Dim cont As Integer
Da.Fill(Ds, Tabla)
cont = Ds.Tables(Tabla).Rows.Count
If cont = 0 Then
Valor = "0"
Else
Valor = Ds.Tables(Tabla).Rows(0).Item(0).ToString
End If
Return Valor
Catch ex As Exception
'MsgBox(ex.Message)
Return Valor
End Try
End Function
''crear bd
Public Sub CrearBD(ByVal bd As String)
Dim myConnection As New MySqlConnection(conexionmysql())
Dim Cmd As New MySqlCommand("CREATE DATABASE " + bd + " CHARACTER SET utf8 COLLATE utf8_general_ci;", myConnection)
Try
myConnection.Open()
With Cmd
.CommandType = CommandType.Text
.ExecuteNonQuery()
End With
Catch ex As Exception
Throw New Exception(ex.Message)
Finally
myConnection.Close()
End Try
End Sub
End Class
I tried what this Mysql page says to fix my code : https://dev.mysql.com/doc/connector-net/en/connector-net-tutorials-data-adapter.html but it didn't work. I get the following errors
That's a C#-style variable declaration, not VB.Net. Instead of this:
MySqlCommandBuilder cd = New MySqlCommandBuilder(adapter)
It needs to look like this:
Dim cd As New MySqlCommandBuilder(adapter)
I will be very grateful for your help on this.
I am trying to populate a treeview to show only a directory as its main root and its sub directories. Other codes and tutorials online show drives and other special folders.
I wan to show only a folder path like:
C:\Main Folder\Subdirectory1\Subdirectory2 etc. in the nodes
This is all I have and its not helping.
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs)
'Get a list of drives
Dim drives As DriveInfo() = DriveInfo.GetDrives()
Dim rootDir As String = String.Empty
'Now loop thru each drive and populate the treeview
For i As Integer = 0 To drives.Length - 1
rootDir = drives(i).Name
'Add this drive as a root node
TreeView1.Nodes.Add(rootDir)
'Populate this root node
PopulateTreeView(rootDir, TreeView1.Nodes(i))
Next
End Sub
Private Sub PopulateTreeView(dir As String, parentNode As TreeNode)
Dim folder As String = String.Empty
Try
Dim folders As String() = System.IO.Directory.GetDirectories(dir)
If folders.Length <> 0 Then
Dim childNode As TreeNode = Nothing
For Each folder_loopVariable As String In folders
folder = folder_loopVariable
childNode = New TreeNode(folder)
childNode.Nodes.Add("")
parentNode.Nodes.Add(childNode)
Next
End If
Dim files As String() = System.IO.Directory.GetFiles(dir)
If files.Length <> 0 Then
Dim childNode As TreeNode = Nothing
For Each file As String In files
childNode = New TreeNode(file)
parentNode.Nodes.Add(childNode)
Next
End If
Catch ex As UnauthorizedAccessException
parentNode.Nodes.Add(folder & Convert.ToString(": Access Denied"))
End Try
End Sub
He tomado como base tu código y he hecho algunas modificaciones para poder adaptarlo a mis necesidades.
Si necesitas crear una lista de todos los archivos por unidades, la funcion ActualizaTV es la encargada de Actualizar el TreeView que, en mi caso, se llama tvDir
Te dejo el resultado por si te viene bien:
Sub ActualizaTV(workpath As String)
If workpath Is Nothing Then Exit Sub
With tvDir
.Nodes.Clear()
'Creating the root node
.Nodes.Add(New TreeNode(workpath))
PopulateTreeView(workpath, .Nodes(0))
End With
End Sub
Sub PopulateTreeView(dir As String, parentNode As TreeNode)
Try
'Se añada en primer lugar los archivos del directorio
For Each file In System.IO.Directory.GetFiles(dir)
If file.Length = 0 Then Continue For
parentNode.Nodes.Add(New TreeNode(file.Replace(dir & "\", "")))
Next
'Se buscan las posibles carpetas nuevas del directorio y se añadem
For Each folder As String In System.IO.Directory.GetDirectories(dir)
If folder.Length = 0 Then Continue For
parentNode.Nodes.Add(New TreeNode(folder))
'En caso de que haya subcarpetas, se repite la operación
If UBound(System.IO.Directory.GetDirectories(folder)) > 0 Or _
UBound(System.IO.Directory.GetFiles(folder)) > 0 Then _
PopulateTreeView(folder, parentNode.LastNode)
Next
Catch ex As UnauthorizedAccessException
parentNode.Nodes.Add(dir & Convert.ToString(": Access Denied"))
End Try
End Sub
Un saludo
I think the title says it all. I can send emails using outlook but now we switched to Gmail and lost all of our notification functionality in our databases.
Yes, you can send mails from Access using gmail accounts. You need CDO library-reference. Search for it ("cdo"+"access"+"send" "mail")
Then, you send them with a function like this (comments in spanish):
Function Enviar_Mail_CDO(Para As String, _
De As String, _
Asunto As String, _
Mensaje As String, _
Usuario As String, _
Password As String, _
Optional Path_Adjunto As String) As Boolean
'Me.MousePointer = vbHourglass
' Variable de objeto Cdo.Message
Dim Obj_Email As CDO.Message
Dim SerVidor_SMTP As String
Dim Puerto As String
Dim Usar_Autentificacion As Boolean
Dim usar_ssl As Boolean
SerVidor_SMTP = "smtp.gmail.com"
Puerto = "465"
Usar_Autentificacion = True
usar_ssl = True
' Crea un Nuevo objeto CDO.Message
Set Obj_Email = New CDO.Message
' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _
del servidor o su dirección IP )
Obj_Email.Configuration.Fields(cdoSMTPServer) = SerVidor_SMTP
Obj_Email.Configuration.Fields(cdoSendUsingMethod) = 2
' Puerto. Por defecto se usa el puerto 25, en el caso de Gmail se usan los puertos _
465 o el puerto 587 ( este último me dio error )
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(Puerto)
' Indica el tipo de autentificación con el servidor de correo _
El valor 0 no requiere autentificarse, el valor 1 es con autentificación
Obj_Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(Usar_Autentificacion)
' Tiempo máximo de espera en segundos para la conexión
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
' Configura las opciones para el login en el SMTP
If Usar_Autentificacion Then
' Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro _
mas el #gmail.com )
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usuario
' Password de la cuenta
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password
' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = usar_ssl
End If
' *********************************************************************************
' Estructura del mail
'**********************************************************************************
' Dirección del Destinatario
Obj_Email.To = Para
' Dirección del remitente
Obj_Email.From = De
' Asunto del mensaje
Obj_Email.Subject = Asunto
' Cuerpo del mensaje
Obj_Email.TextBody = Mensaje
'Ruta del archivo adjunto
If Path_Adjunto <> vbNullString Then
Obj_Email.AddAttachment (Path_Adjunto)
End If
' Actualiza los datos antes de enviar
Obj_Email.Configuration.Fields.Update
On Error Resume Next
' Envía el email
Obj_Email.Send
If Err.Number = 0 Then
Enviar_Mail_CDO = True
Else
MsgBox Err.Description, vbCritical, " Error al enviar el amil "
End If
' Descarga la referencia
If Not Obj_Email Is Nothing Then
Set Obj_Email = Nothing
End If
On Error GoTo 0
'Me.MousePointer = vbNormal
End Function
It is probably really easy for you but i'm a beginner and I don't find how to save the mofifications in my database after an bulkcopy.
The situation i'm trying to import a .csv file into my database using this code :
Public Sub ImportCSV2SQL(ByVal fileName As String, ByRef sqlTable As DataTable, ByVal column2Import() As Integer)
' Préparation des variables SQL
Dim sqlConxtion As SqlConnection = New SqlConnection(My.Resources.sqlHQSdbConxtion)
Dim sqlAction As SqlBulkCopy = New SqlBulkCopy(My.Resources.sqlHQSdbConxtion)
Dim sqlCommand As New SqlCommand("DELETE FROM dbo." & sqlTable.TableName, sqlConxtion)
' Préparation des variables StreamReader et CsvReader
Dim stream As StreamReader = New StreamReader(fileName) : Dim streamCount As StreamReader = New StreamReader(fileName)
Dim csvCopy As CsvReader = New CsvReader(stream, True, ";"c)
' Décompte du nombre de lignes dans le fichier *.CSV
Dim nbrLines As Integer = 0
While streamCount.Peek <> -1
nbrLines += 1
Dim line As String = streamCount.ReadLine()
End While
' Comparaison avec la table existante dans SQL et le nombre de lignes est plus conséquente
' dans le *.CSV alors remplacement de la table sinon demande à l'utilisateur s'il veut la
' remplacer(1) ou annuler l'action (2)
If sqlTable.Rows.Count <= nbrLines - 1 And sqlTable.Rows.Count <> 0 Then
If MsgBox("The number of rows of the CCList that you are trying to import is higher than those of those of the already existing " & _
"CCList. Do you want to replace the old table or abort the importation?", MessageBoxButtons.OKCancel) = 1 Then
Exit Sub
End If
End If
' Tentative de se conecter au serveur SQL
Try
sqlCommand.Connection.Open()
Catch myerror As SqlException
MsgBox("Error connection SQL")
sqlCommand.Connection.Close()
Exit Sub
End Try
' Suppression de la table afin de pouvoir y introduire de nouvelles données
sqlCommand.ExecuteNonQuery()
sqlCommand.Connection.Close()
' Mappings des colonnes entre le fichier *.CSV et la table de destination
For i = 0 To column2Import.Length - 1
sqlAction.ColumnMappings.Add(column2Import(i), i)
Next
' Transfère des données des données du fichier *.CSV à la table de destination
sqlAction.DestinationTableName = sqlTable.TableName
sqlAction.WriteToServer(csvCopy)
End Sub
But even if i know that it does what it have to it does not save the datas in my database. What am I doing wrong?
I'm using the zxing C# port to decode a QR barcode.
The code is simple and based on an example I found online (see below).
The problem is, it always throws an "Index was outside the bounds of the array" exception.
My code sample happen to be in VB.NET, but the zxing library is implemented in C#
Dim re As qrcode.QRCodeReader
re = New qrcode.QRCodeReader()
Dim Img As New Bitmap("<image file path here>")
Dim res As com.google.zxing.Result
Dim bufimg As com.google.zxing.client.j2se.BufferedImageMonochromeBitmapSource
bufimg = New client.j2se.BufferedImageMonochromeBitmapSource(Img, False)
res = re.decode(bufimg)
Dim ret As String = res.getText()
I have seen multiple people complaining about the same issue in different forums, but haven't found any suggested solution.
UPDATE If anyone knows of a different good QR reader that can easily integrate with a .NET application, please recommend
Dont know if this gonna help u, but i paste my code if u want to use:
Imports Zxing = com.google.zxing
Imports System.Drawing
Public Class Decodificador
'Para leer todo tipo de codigos soportados por el proyecto zxing
Private Reader As New Zxing.MultiFormatReader
'Private Reader As New Zxing.qrcode.QRCodeReader
Private Result As Zxing.Result
Private Imagen As Bitmap
Private Bitm As Zxing.BinaryBitmap
Private HBin As Zxing.common.HybridBinarizer
Private Lumin As RGBLuminanceSource
'El orden para poder funcionar es:
'DetectarCodigoEnImagen (Obligatorio) >> PintarLocalizacion [opcional] >> DecodificarImagen (Obligatorio para sacar info).
''' <summary>
''' Devuelve True si ha localizado un QRCODE
''' </summary>
''' <param name="img"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function DetectarCodigoEnImagen(ByRef img As Image) As Boolean
Try
Imagen = New Bitmap(img)
'Creamos un Mapa binario con la imagen y su tamaño
Lumin = New RGBLuminanceSource(Imagen, Imagen.Width, Imagen.Height)
HBin = New Zxing.common.HybridBinarizer(Lumin)
Bitm = New Zxing.BinaryBitmap(HBin)
'Decodificamos el mapa binario y guardamos todos los datos en Result
Result = Reader.decode(Bitm)
'Si ha encontrado un QRCode provocará una excepción y devolverá False
'Si hay un QRCode, devolverá True
Return True
Catch ex As Exception
Return False
End Try
End Function
''' <summary>
''' Dibuja cuadros rojos y amarillos en la localización del Codigo QR, ralentiza mucho el sistema.
''' Debe haberse detectado un codigo en la imagen para poder pintar.
''' Devuelve la imagen con el Codigo QR y la localización pintada
''' </summary>
''' <param name="img"></param>
''' <remarks></remarks>
Public Function PintarLocalizacionQrCode(ByRef img As Image) As Image
Try
'Archivamos en una matriz todos los puntos de localización del QRcode
Dim Puntos() As Zxing.ResultPoint = Result.ResultPoints
'Creamos Graficos desde la imagen y poder pintar posteriormente
Dim gr As Graphics = Graphics.FromImage(Imagen)
'Dim gr As Graphics = Graphics.FromImage(Imagen)
'Declaramos el tamaño del pincel para pintar y pintar2
Dim TamPincel As Integer = 4
Dim Pintar As New Pen(Color.Yellow, TamPincel)
Dim Pintar2 As New Pen(Color.Red, TamPincel)
'Declaramos una variable del mismo tipo que el arreglo Puntos() para poder navera por ella
Dim PuntoAuxiliar As com.google.zxing.ResultPoint
'Por cada punto en puntos() dibujamos 2 rectangulos en los indicadores de posición del QRCode
For Each PuntoAuxiliar In Puntos
gr.DrawRectangle(Pintar, New Rectangle(PuntoAuxiliar.X - 10, PuntoAuxiliar.Y - 10, 20, 20))
gr.DrawRectangle(Pintar2, New Rectangle(PuntoAuxiliar.X - 13, PuntoAuxiliar.Y - 13, 26, 26))
Next
'Liberamos la memoria
gr.Dispose()
Return Imagen
Catch ex As Exception
Throw ex
End Try
End Function
End Class