Archivo de la etiqueta: Visual Basic

Como extraer un email de un texto en Visual Basic

Esta es una función que suelo utilizar para extraer emails de texto. Es la versión simplificada para encontrar un solo email ya que con una modificación en el Gosub puede capturar un número indeterminado de emails y almacenarlos en una colección de objetos.

La función también sirve de ejemplo para la utilización de varias sentencias de manejo de strings en Visual Basic: Instr, Len, Mid y Asc

[VB]
Public Function CapturarEmailTexto(Texto) As String
Dim indPos As Long
Dim indDesde As Long
Dim indHasta As Long
Dim strEmail As String
Dim strInt As String
On Error GoTo ErrorSub
CapturarEmailTexto = “”
strEmail = “”
If InStr(1, Texto, “@”) = 0 Then Exit Function
For indPos = 1 To Len(Texto)
If Mid(Texto, indPos, 1) = “@” Then
GoSub Captura
Exit For
End If
Next
CapturarEmailTexto = strEmail
Exit Function
Captura:
indDesde = 0
indHasta = 0
‘ Buscar Inicio de Email
For indDesde = indPos – 1 To 0 Step -1
If indDesde = 0 Then Exit For
strInt = Mid(Texto, indDesde, 1)
If strInt = ” ” Then Exit For
If strInt = “:” Then Exit For
If strInt = “(” Then Exit For
If strInt = “)” Then Exit For
If strInt = “[” Then Exit For
If strInt = “]” Then Exit For
If strInt = “<" Then Exit For If strInt = ">” Then Exit For
If strInt = “””” Then Exit For
If strInt = “‘” Then Exit For
If Asc(strInt) = 13 Then Exit For ‘ Control de Return
If Asc(strInt) = 10 Then Exit For ‘ Control de Return
Next
‘ Buscar Final de Email
For indHasta = indPos + 1 To Len(Texto)
strInt = Mid(Texto, indHasta, 1)
If strInt = ” ” Then Exit For
If strInt = “:” Then Exit For
If strInt = “(” Then Exit For
If strInt = “)” Then Exit For
If strInt = “[” Then Exit For
If strInt = “]” Then Exit For
If strInt = “<" Then Exit For If strInt = ">” Then Exit For
If strInt = “””” Then Exit For
If strInt = “‘” Then Exit For
If Asc(strInt) = 13 Then Exit For ‘ Control de Return
If Asc(strInt) = 10 Then Exit For ‘ Control de Return
Next
‘ Determinar Mail
strEmail = Mid(Texto, indDesde + 1, indHasta – indDesde – 1)
‘ Eliminar Caracteres Finales incorrectos
If Right(strEmail, 1) = “.” Then strEmail = Mid(strEmail, 1, Len(strEmail) – 1)
If Right(strEmail, 1) = “,” Then strEmail = Mid(strEmail, 1, Len(strEmail) – 1)
Return
ErrorSub:
MsgBox Err.Number & “: ” & Err.Description
End Function
[/VB]

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Contar caracteres en una cadena

Rutina que permite contar las apariciones de una cadena dentro de otra.

[VB]
Public Function CuentaPalabras(Texto As String, Palabra As String) As Long
Dim wptr As Long
Dim count As Long
wptr = InStr(Texto, Palabra)
Do Until wptr = 0
count = count + 1
wptr = InStr(wptr + 1, Texto, Palabra)
Loop
CuentaPalabras = count
End Function
[/VB]

Referencia: Foro VB-Mundo

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Uso de Redim en Visual Basic

La instrucción Redim permite redimensionar una matriz en Visual Basic.

Es útil en aquellos casos en que necesitamos almacenar datos en una matriz pero no sabes, a priori, cual será el número total de elementos a incorporar.

Un ejemplo práctico es cuando hacemos una utilidad para tratar los archivos de una carpeta pero al hacer el programa no sabemos cuantos archivos puede llegar a contener dicha carpeta y no sería eficiente diseñar matrices enormes para prever cualquier situación.

[VB]
Option Explicit
Dim MiMatriz() As String
Private Sub Form_Load()
ReDim MiMatriz(NuevoIndice) As String
End Sub
[/VB]

La instrucción Redim puede ir seguido del parámetros Preserve: “Redim Preserve…” como su nombre indica lo que se hace es indicarle que al aumentar el tamaño de la matriz se preserven los datos de la misma.

La instrucción Redim puede utilziarse también para liberar espacio en una matriz ya procesada y que no necesitamos tener sus datos. Por ejemplo poniendo ReDim MiMatriz(0)

Como iterar por la matriz:

[VB]
Dim ind as integer
For ind = 0 To UBound(MiMatriz)
debug.print MiMatriz(ind)
Next
[/VB]

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Convertir un MDB de Access a Texto

Esta es una pequeña utilidad desarrollada con Visual Basic que permite convertir a un fichero de texto una base de datos de Microsoft Access. El proceso crea una subcarpeta donde están las bases de datos y en la misma crea un fichero por cada una de la tablas del MDB. En principio se crean en formato csv pero modificando el parámetro de esta instrucción es posible obtener la información en otros formatos como acFormatActiveXServer, acFormatHTML, acFormatIIS, acFormatRTF, acFormatTXT, acFormatXLS:

[VB]
app.DoCmd.OutputTo acOutputTable, tdf.Name,acFormatTXT, strFolderOutput & “\” & tdf.Name & “.txt”
[/VB]

Hay dos métodos posibles para la exportación el DoCmd.TransferText y el DoCmd.OutputTo, se pueden utilizar cualquiera de los dos.

Aquí está el archivo para descargar y debajo el código del formulario (también hay un módulo en el proyecto con 2 funciones complementarias.

MDB2txt

Código del formulario:

[VB]
Option Explicit
Dim app As Access.Application
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strMDB2txt As String
Dim strSQL As String
Dim strFolderOutput As String
Dim fso As FileSystemObject

Private Sub Form_Load()
‘Me.Width = 6500
‘Me.Height = 3300
End Sub
Private Sub cmdMDB2txt_Click()
cdgMDB2txt.DefaultExt = “mdb”
cdgMDB2txt.ShowOpen
strMDB2txt = ValidarString(cdgMDB2txt.FileName)
If strMDB2txt <> “” Then
txtMDB2txt = strMDB2txt
Else
txtMDB2txt = “”
End If
End Sub
Private Sub cmdCancelar_Click()
Unload Me
End Sub
Private Sub cmdConvertir_Click()
‘ Inicio de Proceso
lblMDB2txt.Caption = “Iniciando proceso …”
Set app = New Access.Application
app.OpenCurrentDatabase strMDB2txt
Set fso = New FileSystemObject
Set dbs = OpenDatabase(strMDB2txt)
strFolderOutput = ArchivoInformacion(strMDB2txt, itxpath) & “\” & Mid(Dir(strMDB2txt), 1, (Len(Dir(strMDB2txt)) – 4))
If fso.FolderExists(strFolderOutput) = False Then
fso.CreateFolder strFolderOutput
End If
‘ Procesar las Tablas
For Each tdf In dbs.TableDefs
GoSub ExportarTabla
Next
‘ Cerrar Bases de Datos
dbs.Close
Set app = Nothing
Set fso = Nothing
‘ Fin de Proceso
MsgBox “Proceso Finalizado”, vbInformation, “Convertir MDB a Texto”
txtMDB2txt = “”
lblMDB2txt.Caption = “”
Exit Sub
ExportarTabla:
If tdf.Attributes = dbAttachedTable Then Return
If LCase(Left(tdf.Name, 4)) = “msys” Then Return
lblMDB2txt.Caption = “Convirtiendo ” & tdf.Name
app.DoCmd.TransferText acExportDelim, “”, tdf.Name, strFolderOutput & “\” & tdf.Name & “.csv”
‘app.DoCmd.OutputTo acOutputTable, tdf.Name,acFormatTXT, strFolderOutput & “\” & tdf.Name & “.txt”
Me.Refresh
Return
End Sub

[/VB]

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Visual Basic. Copiar y Pegar Archivos desde ClipBoard

Este ejemplo permite recuperar la lista de archivos copiados en el Clipboard.

Ejemplo Copy and Paste

En caso de usar en un Control ActiveX cambiar Me.Hwnd por UserControl.Hwnd.

Código completo:

[VB]
Option Explicit
Private Declare Function DragQueryFile Lib “shell32.dll” Alias “DragQueryFileA” (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib “shell32.dll” (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib “kernel32” (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib “kernel32” (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib “kernel32” (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib “kernel32” (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function EmptyClipboard Lib “user32” () As Long
Private Declare Function OpenClipboard Lib “user32” (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib “user32” () As Long
Private Declare Function SetClipboardData Lib “user32” (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib “user32” (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib “user32” (ByVal wFormat As Long) As Long

Private Const GHND = &H42
Private Const CF_HDROP = &HF
Private Const GET_DROP_COUNT = &HFFFFFFFF
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type

Dim iCounter As Integer ‘counter
Dim DF As DROPFILES
Dim strFiles As String ‘keeps the paths of files we want to copy
‘to the clipboard
Dim hGlobal As Long ‘keeps the location from the files we want to copy
‘the clipboard
Dim lpGlobal As Long ‘is the globallocked hGlobal
Dim hDrop As Long ‘keeps the info from the clipboard
Dim lFiles As Long ‘keeps the amount of files on the clipboard
Dim strFile As String ‘keeps the path of the file

Private Sub cmdCopy_Click()
If OpenClipboard(Me.Hwnd) = 0 Then ‘clipboard is still open
If MsgBox(“Clipboard is already opened” & vbCrLf & “close?”, vbYesNo + vbQuestion, Caption) = vbYes Then
‘lets close the clipboard
CloseClipboard
End If
Exit Sub ‘quit
End If
EmptyClipboard ‘lets clear the clipboard

For iCounter = 0 To filelist.ListCount – 1
If filelist.Selected(iCounter) = True Then
strFiles = strFiles & FixPath(filelist.Path) & filelist.List(iCounter) & vbNullChar
End If
Next
‘all selected items are now put in strFiles

hGlobal = GlobalAlloc(GHND, Len(DF) + Len(strFiles)) ‘put all files to a exclusive number
If hGlobal Then ‘if the globalalloc worked
lpGlobal = GlobalLock(hGlobal) ‘lock the hGlobal
DF.pFiles = Len(DF) ‘set the size of the files

Call CopyMem(ByVal lpGlobal, DF, Len(DF)) ‘copy df to the lpglobal
Call CopyMem(ByVal (lpGlobal + Len(DF)), ByVal strFiles, Len(strFiles)) ‘copy strfiles to lpglobal
Call GlobalUnlock(hGlobal) ‘unlock hglobal again

SetClipboardData CF_HDROP, hGlobal ‘put files to the clipboard
End If
CloseClipboard
End Sub
Private Sub cmdPaste_Click()
‘first lets check if there are files on the clipboard
If IsClipboardFormatAvailable(CF_HDROP) = 0 Then Exit Sub
‘exit sub if there aren’t

If OpenClipboard(Me.Hwnd) = 0 Then ‘clipboard is still open
If MsgBox(“Clipboard is already opened” & vbCrLf & “close?”, vbYesNo + vbQuestion, Caption) = vbYes Then
‘lets close the clipboard
CloseClipboard
End If
Exit Sub ‘quit
End If

hDrop = GetClipboardData(CF_HDROP) ‘get the data from the clipboard
lFiles = DragQueryFile(hDrop, -1&, “”, 0) ‘count amount of files

strFile = Space(260) ‘create new string
For iCounter = 0 To lFiles – 1 ‘for each file on the clipboard
Call DragQueryFile(hDrop, iCounter, strFile, Len(strFile))
‘get every specific file
ListPastedFiles.AddItem strFile
Debug.Print strFile
‘add them to the listpastedfiles
Next
CloseClipboard
End Sub
Public Function FixPath(strPath As String) As String
If Right(strPath, 1) <> “\” Then
FixPath = strPath & “\”
Else
FixPath = strPath
End If
‘always put an “\” behind a path
End Function

Private Sub Form_Load()
filelist.Path = “c:\”
End Sub

[/VB]

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Documentos PDF en Visual Basic

Hay algunas aplicaciones que permiten que una persona firme un documento en una tableta digital y es necesario guardar una copia del mismo en el PC. Existen varias tables digitalizadoras que permiten realizar la firma e insertarla automáticamente en un documento PDF que tengamos abierto en ese momento.

El objetivo de esta entrada es describir como podemos generar PDF a partir de un modelo fijo con campos de formulario para fecha, nombre de la persona, etc. y una base de datos de nombres que tengamos en Access utilizando para ello Visual Basic 6.0.

Para ello tendremos un proyecto de Visual Basic con un formulario en el cual pondremos un primer desplegable para seleccionar de nuestra base de datos la persona que va a firmar el documento PDF. En caso de no tener las personas en base de datos podemos poner un campo de texto para escribir el nombre de la persona.

Seguidamente debemos tener un botón que permita seleccionar el PDF que se va a firmar. Si sólo tenemos un PDF basta con poner su ruta como valor interior o de formulario, si tenemos varios modelos debe haber un sistema que permita la sección del modelo a utilizar.

El problema surge en el momento de rellenar los campos del formulario PDF desde Visual Basic, a pesar de cargar todas las DLL disponibles de Acrobat en niguna de las clase aparecen métodos que permitan cambiar el valor de los campos de un formulario, o por lo menos, no lo supe encontrar. Existe una librería en Sourgeforge que permite asignar valores a los campso entre muchas otras funciones pero el problema es que está diseñada para Visual .Net y no es compatible con Visual Basic.

Sin embargo Googleando un mucho encontré una solución distinta y que me ha servidor, se trata de crear los campos en el documento PDF y después para a modo de relleno y asignar a cada campo un valor distinto, por ejemplo:

  • Fecha: C01-123456
  • Nombre: C02-1234567890123456789012345678901234567890123456
  • DNI: C03-12345678

Después se abre el PDF en modo binario y con la instrucción Replace cambios estos valores por los valores del formulario, por ejemplo:

Open "InputDocument.pdf" For Binary As #1
strBytes = Space$(LOF(1))
Get #1, 1, strBytes
Close #1
strBytes = Replace(strBytes, "C01-123456", Format(Date, "dd-mm-yyyy"))
strBytes = Replace(strBytes, "C03-12345678", "B45123678")
' Grabar fichero de salida
Open strDocumento For Binary As #2
Put #2, , strBytes
Close #2

Lo quese debe tener en cuenta es que el String sustituido debe tener el mismo tamaño exacto.

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Split:Separar un String en varias partes

Se utiliza la función Split:

[VB]

Dim matStrings() As String
txtstrings = “Uno,Dos,Tres”
matStrings = Split(txtStrings, “,”)
[/VB]

Obtenemos una matriz de Strings con cada uno de los elementos:

matstrings(1) = “Uno”
matstrings(2) = “Dos”
matstrings(3) = “Tres”

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Equivalencias PHP – Visual Basic

Obtener un fragmento de una Cadena (String)

Visual Basic:
[VB]
Dim MyString As String
MyString = “This is string example”
MsgBox Mid(MyString, 5, 10)
[/VB]
PHP:
[PHP]
$MyString = “This is string example”;
echo substr($MyString,5,10);
[/PHP]
Nota: En ambos casos el contador de caracteres empieza en 0


1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…

Nomenclatura de Controles ActiveX en Visual Basic

Descripción de los nombres que se deben utilizar al crear un control ActiveX.

Se toma como ejemplo un control de INTEX WinBol que calcula la tabla de clasificación de una competición:

Elemento

Nombre

Comentario

Control

Nombre del ControlClasificacionDescripción Nmemotécnica
Nombre de ficheroClasificacion.ctl= Control
Nombre del OCXClasificacion.ocx= Control

Proyecto

Nombre de ficheroClasificacionP.vbp= Control + P
Nombre del proyectoClasificacionP= Control + P
Descripción del ProyectoINTEX WinBol ClasificacionEs lo que se ve en Referencias, se pone delante la aplicación a la que pertenece.

Proyecto de Test

Nombre de ficheroProyecto1.vbpNombre poco importante
Nombre del proyectoProyecto1Nombre poco importante
Formulario de TestForm1Nombre poco importante

Grupo de Proyectos

Grupo1Nombre poco importante
1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
Cargando…