Como abrir una base de datos Access 97 protegida con contraseña:

Dim Ws1 as workspace
Dim Db as database
Set Ws1 = CreateWorkspace(“”,”Admin”,”",dbUseJet)
Set Db = Ws1.OpenDatabase(“nombre_base_datos”, False,False,”;PWD=contraseña”)

Si quieres hacerlo con un Control Data:
Data1.DatabaseName = “Nombredelabasededatos”
Data1.Connect = “;pwd=la_contraseña”
Data1.RecordSource = “NombreTabla”

Como hacer que al entrar en un Text Box se marque todo el contenido:

Create una sub como la siguiente en un modulo .bas de tu proyecto:

Sub MarcaTodo(Campo As TextBox)
Campo.SelStart = 0
Campo.SelLength = Len(Campo)
End Sub

Ahora en el evento GotFocus de cada textbox en el que desees
que actue esta accion:

Private Sub tu_text_box_GotFocus()
MarcaTodo tu_text_box
End Sub

Como pasar al siguiente TextBox pulsando RETURN:

Create una sub como la siguiente en un modulo .bas de tu proyecto:

Sub Tabula(KeyAscii As Integer)


If KeyAscii = 13 Then
SendKeys “{TAB}”, True
KeyAscii = 0 ‘ para evitar un ‘beep’ indeseado
End If
End Sub

Ahora en el evento KeyPres de cada textbox en el que
desees que actue esta accion:

Private Sub Tu_Text_Box_KeyPress(KeyAscii As Integer)
Tabula KeyAscii
End Sub

** una forma más elaborada y que permite no tener que poner la funcion en cada TextBox:
1.- Poner la propiedad KeyPreview del formulario a True
2.- En el evento KeyPress del formulario llamar a la funcion Tabula (la descrita anteriormente):
Private Sub Form1_KeyPress(KeyAscii As Integer)
Tabula KeyAscii
End Sub

Como hacer en un Text Box sólo puedan entrarse numeros:

Create una funcion como la siguiente en un modulo .bas de tu proyecto:

Function SoloNumeros(ByVal KeyAscii As Integer) As Integer
‘ Intercepta un codigo ASCII recibido admitiendo solamente
‘ caracteres numéricos, además:
‘ cambia el punto por una coma
‘ acepta el signo -
‘ deja pasar sin afectar si recibe tecla de borrado o return
If KeyAscii = Asc(“.”) Then KeyAscii = Asc(“,”)
If InStr(“0123456789.,-”, Chr(KeyAscii)) = 0 Then
SoloNumeros = 0
Else
SoloNumeros = KeyAscii
End If
‘ teclas especiales permitidas
If KeyAscii = 8 Then SoloNumeros = KeyAscii ‘ borrado atras
If KeyAscii = 13 Then SoloNumeros = KeyAscii ‘ return
End Function

Ahora en el evento KeyPres de cada textbox en el que desees que actue
esta accion:

Private Sub Tu_Text_Box_KeyPress(KeyAscii As Integer)
Keyascii = solonumeros(Keyascii)
End Sub

Como facilitar la entrada de una fecha en un Text Box:

Esto permite que el usuario entre las fechas en formato DDMMAA y la función hará el trabajo sucio de convertirla a DD/MM/AA (o DD/MM/AAAA)

Create una funcion como la siguiente en un modulo .bas de tu proyecto:

Function fFecha(ByVal CAMPO As String) As String
fFecha = CAMPO
If InStr(CAMPO, “/”) = 0 Then
If Len(CAMPO) = 6 Then
fFecha = Mid(CAMPO, 1, 2) & “/” & Mid(CAMPO, 3, 2) & “/” & Right(CAMPO, 2)
End If
If Len(CAMPO) = 8 Then ‘ si el año tiene 4 digitos
fFecha = Mid(CAMPO, 1, 2) & “/” & Mid(CAMPO, 3, 2) & “/” & Right(CAMPO, 4)
End If
End If
End Function
Ahora en el evento LostFocus del textbox en el se entra una fecha:

Private Sub Tu_Text_Box_LostFocus()
Tu_Text_Box = fFecha(Tu_Text_Box)
End Sub

Como saber si un control forma parte de un array:

Esta funcion te permite saber si un control forma parte de un array de controles o no:

Function EsArray(objeto As Object) As Boolean
‘ recibe un objeto e informa si dicho objeto forma parte de un array
On Error GoTo Error
EsArray = False
If objeto.Index >= 0 Then EsArray = True
Error:
End Function

Como saber si hay un diskette colocado:

Esta funcion te permite saber si hay un diskette colocado en la disketera o no:

Function HayDisket() As Boolean
On Error GoTo Error
HayDisket = False
ChDrive “A”
HayDisket = True
ChDrive “C” ‘ para que proximo intento funcione correctamente
Exit Function
Error:
ChDrive “C” ‘ para que proximo intento funcione correctamente
End function

Comprobar la existencia de un archivo:

Esta funcion devuelve verdadero o falso segun exista o no el archivo buscado

Function ExisteArchivo(cArchivo As String) As Boolean
ExisteArchivo = IIf(Dir$(cArchivo) = “”, False, True)
End Function
Evitar el error ‘uso invalido de null’:
Esta funcion te evitará este error al usar campos de BD con valor nulo:

Function NoNul(ByVal Datoentrada As Variant) As Variant
NoNul = IIf(IsNull(Datoentrada), “”, Datoentrada)
End Function

Al usar un campo de BD que pueda contener Null: campo = NoNul(recordset!campo)

Envio de e-mail desde VB:

1.- Adjuntar al proyecto los controles MAPI
(ya sabes: Proyecto/Componentes y señalar Microsoft MAPI controls)
2.- En tu formulario, coloca los controles MAPISession y MAPIMessages
3.- Para enviar el mail:
MAPISession1.UserName = “nombre del remitente”
MAPISession1.NewSession = True
MAPISession1.DownLoadMail = True ‘ o false si no deseas recibir
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID

MAPIMessages1.MsgIndex = -1 ‘ nuevo mensaje
MAPIMessages1.RecipDisplayName = “nombre del destinatario”

MAPIMessages1.ResolveName ‘ esto comprueba que el destinatario exista en las direcciones
MAPIMessages1.MsgSubject = “texto del asunto”
MAPIMessages1.MsgNoteText = “texto del mensaje”

‘ si deseas anexar algun archivo al mail:
MAPIMessages1.AttachmentIndex = 0 ‘ numero del anexo, 0,1,2,3….
MAPIMessages1.AttachmentName = “nombre_del_archivo_a_anexar”
MAPIMessages1.AttachmentPathName = “path_completo_del archivo_a_enviar”
MAPIMessages1.AttachmentPosition = 0 ‘ numero del anexo, 0,1,2,3…
MAPIMessages1.AttachmentType = 0 ‘ archivo de datos
‘ (puedes anexar varios archivos, incrementando el numero 0,1,2,3….)
‘ Y por fin, enviarlo:
MAPIMessages1.Send

‘ Cuando ya no tengas que enviar ningun mail más:
MAPISession1.SignOff
IMPORTANTE: Tu programa de mail debe ser cliente MAPI predeterminado:
en Outlook Express: Herramientas,Opciones,General y marcar la opcion correspondiente.

Recepción de e-mail desde VB:

1.- Adjuntar al proyecto los controles MAPI
(ya sabes: Proyecto/Componentes y señalar Microsoft MAPI controls)
2.- En tu formulario, coloca los controles MAPISession y MAPIMessages
3.- Para recibir el mail:
Dim nCanMsg As Integer
Dim cNomFic As String
Dim nX As Integer
Dim nY As Integer
MAPISession1.UserName = “nombre_del _destinatario”
MAPISession1.NewSession = True
MAPISession1.DownLoadMail = True
MAPISession1.SignOn

MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.FetchUnreadOnly = True ‘ Solo los no leidos
MAPIMessages1.FetchSorted = True ‘ ordenados segun llegada
MAPIMessages1.Fetch ‘ obtiene el conjunto de mensajes

nCanMsg = MAPIMessages1.MsgCount – 1
For nX = 0 To nCanMsg
MAPIMessages1.MsgIndex = nX
‘ Filtrado de los mensajes para seleccionar los deseados segun el asunto
If MAPIMessages1.MsgSubject = “asunto_deseado” Then
‘ Si te interesa el texto del mensaje, está en MAPIMessages1.MsgNoteText
‘ Por cada archivo anexado al mensaje, extraerlo y copiarlo donde queramos
For nY = 0 To MAPIMessages1.AttachmentCount – 1
MAPIMessages1.AttachmentIndex = nY
cNomFic = ExtraerNombreArchivo(MAPIMessages1.AttachmentName)
FileCopy MAPIMessages1.AttachmentPathName, “path_deseado” + “\” +cNomFic
Next
‘ borrado del mensaje (si queremos hacerlo)
MAPIMessages1.Delete (mapMessageDelete)
End If
Next
‘ Cerrar las sesion
MAPISession1.SignOff

‘ Esta funcion la necesitas para extraer el nombre del archivo:

Private Function ExtraerNombreArchivo(cArchivo As String) As String
‘ extrae el nombre de un archivo de una cadena con path completo
Dim nX As Integer
ExtraerNombreArchivo = “”
For nX = Len(cArchivo) To 1 Step -1
If Not Mid(cArchivo, nX, 1) = “\” Then
ExtraerNombreArchivo = Mid(cArchivo, nX, 1) + ExtraerNombreArchivo
Else
exit for ‘salir del bucle, ya esta.
End If
Next
End Function

IMPORTANTE: Tu programa de mail debe ser cliente MAPI predeterminado:
en Outlook Express: Herramientas,Opciones,General y marcar la opcion correspondiente.

Abrir archivos DBF desde VB:

Dim Db as DataBase
Dim Rs as RecordSet
‘ Lo que se abre como base de datos es realmente el DIRECTORIO donde estan los archivos DBF
Set Db = OpenDatabase(“”, True, False, “dBASE III;database=C:\DirDbf”)
‘ Abrir un DBF (por ejemplo ARTICULOS.DBF ordenado por CODIGO
Set Rs = Db.OpenRecordSet(“SELECT * FROM ARTICULOS ORDER BY CODIGO”)

Nota para CLIPPER: Esto te permite acceder a los archivos DBF pero no se actualizan los indices NTX, si deseas trabajar al completo con archivos de Clipper deberás usar algun producto como ARTEMIS que permite tratar los NTX siendo una solución valida en procesos de migración de aplicaciones mientras deben coexistir programas en Clipper y programas en VB. (Puedes encontrar informacion de ARTEMIS en

http://www.vistasoftware.com/

Calcular letra DNI/NIF:

‘ Se supone que en la variable DNI (numerica) esta el numero del DNI
LetraNIF = Mid$(“TRWAGMYFPDXBNJZSQVHLCKE”, (DNI Mod 23) + 1, 1)
(publicado en las news VB). Aqui os dejo los fuentes de una pequeña aplicación siempre visible para calcular el nif. Nif Visual Basic.

Cerrar todos los formularios:

‘ Una forma elegante de terminar una aplicación cerrando todos los formularios abiertos:
Dim frmX As Form
For Each frmX In Forms
Unload frmX
Set frmX = Nothing
Next
End

Contar el numero de lineas de un TextBox:

Public Declare Function SendMessageLong Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub txtText_Change()
Dim nLineas As Long
nLineas = SendMessageLong(txtText.hwnd, &HBA, 0&, 0&)
‘ ahora tienes en nLineas la cantidad de lineas del TextBox
End Sub

Funcion para saber si un recordset esta vacio:

Funcion para saber si un Recordset esta vacio:

Public Function RecordsetVacio (rs As RecordSet) As Boolean
RecordsetVacio=((rs.BOF=True) And (rs.Eof=True))
End Function

Detectar si una aplicación ya está funcionando:

En el formulario inicial de la aplicación:

Private Sub Form_Load()
Dim sMsg as string
If App.PrevInstance Then
sMsg = App.EXEName ya está en ejecucion”
MsgBox sMsg, 16, “Aplicacion.”
End
End If
End Sub

Apagar el ordenador:

Private Declare Function ExitWindowsEx Lib “user32″ (ByVal uFlags As Long,
ByVal dwReserved As Long) As Long

Public Sub ApagarPc()
Dim lResp as integer
lResp = ExitWindowsEx(1, 0&)
End Sub
NOTAS: el valor pasado a la funcion API puede tener los siguientes 3 valores:
0 = Reinicia Windows con nuevo usuario
1 = Apaga el equipo
2 = Reinicia el sistema

Impedir que el usuario pueda cerrar un formulario:

En el evento QueryUnload del formulario colocar un codigo como el siguiente:

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
MsgBox “Imposible cerrar el formulario” ‘ evidentemente esto es opcional
If UnloadMode = vbFormControlMenu Then ‘ valor cero
Cancel = True
End If
End Sub
Esto no impide que se haga Unload Me controlado por un boton o lo que sea.


Vota este artículo:
1 Estrella2 Estrellas3 Estrellas4 Estrellas5 Estrellas (No Ratings Yet)
Loading ... Loading ...

Posts anterior y posterior:
«
»


Posts Relacionados: