FAQ's de VB6

[GeoAvila]

Respuesta:
como exportar un arhivo a excel, usando un MsFlexgrid O MsHflexgrid, bueno consegui este codigo y uso el MSHFlexGrid, pero lo pueden cambiar a MSFlexGrid, sin ningun problema..

Código:

Sub CopyToExcel(InFlexGrid As MSHFlexGrid, Nome$, _
			   ByVal TextoAdicional$)
  Dim R%, c%, Buf$, LstRow%, LstCol%
  Dim FormatMoney As Boolean
  Dim MyExcel As Excel.Application
  Dim wbExcel As Excel.Workbook
  Dim shExcel As Excel.Worksheet
  On Error Resume Next

  Set MyExcel = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then
	Set MyExcel = CreateObject("Excel.Application")
  End If
  Set wbExcel = MyExcel.Workbooks.Add
  Set shExcel = wbExcel.Worksheets.Add
  shExcel.Name = Nome$
  shExcel.Activate
  LstCol% = 0
  For c% = 0 To InFlexGrid.Cols - 1
	InFlexGrid.Col = c%
	LstRow% = 0
	shExcel.Columns(Chr(Asc("A") + c%)).ColumnWidth = InFlexGrid.ColWidth(c%) / 72
	For R% = 0 To InFlexGrid.Rows - 1
	  InFlexGrid.Row = R%
	  Err.Clear
	  Buf$ = InFlexGrid.TextMatrix(R%, c%)
	  If Buf$ <> "" Then
		FormatMoney = False
		If InStr(Buf$, vbCrLf) Then
		  Buf$ = StrTran(Buf$, vbCrLf, vbLf)
		  Do While Right(Buf$, 1) = vbLf
			Buf$ = Left(Buf$, Len(Buf$) - 1)
		  Loop
		  shExcel.Range(Chr(Asc("A") + c%)).WrapText = True
		ElseIf Format(CDbl(Buf$), csFormatMoneyZero) = Buf$ Then
		  If Err.Number = 0 Then
			Buf$ = Str(CDbl(Buf$))
			FormatMoney = True
		  End If
		End If
		If Buf$ <> "" Then
		  If InFlexGrid.MergeRow(R%) Then
			For LstCol% = c% To 1 Step -1
			  If InFlexGrid.TextMatrix(R%, LstCol% - 1) <> InFlexGrid.TextMatrix(R%, c%) Then
				Exit For
			  End If
			Next
			If LstCol% <> c% Then
			  shExcel.Range(Chr(Asc("A") + LstCol%) & (R% + 1), _
						   Chr(Asc("A") + c%) & (R% + 1)).MergeCells = True
			  shExcel.Range(Chr(Asc("A") + LstCol%) & (R% + 1), _
						   Chr(Asc("A") + c%) & (R% + 1)).BorderAround
			End If
		  End If
		  If InFlexGrid.MergeCol(c%) And LstRow% <> R% Then
			If InFlexGrid.TextMatrix(LstRow%, c%) = InFlexGrid.TextMatrix(R%, c%) Then
			  shExcel.Range(Chr(Asc("A") + c%) & (LstRow% + 1), _
						   Chr(Asc("A") + c%) & (R% + 1)).MergeCells = True
			  shExcel.Range(Chr(Asc("A") + c%) & (LstRow% + 1), _
						   Chr(Asc("A") + c%) & (R% + 1)).BorderAround
			Else
			  LstRow% = R%
			End If
		  End If
		  shExcel.Range(Chr(Asc("A") + c%) & _
					   (R% + 1)).Font.Color = InFlexGrid.CellForeColor
		  If R% < InFlexGrid.FixedRows Or c% < InFlexGrid.FixedCols Then
			shExcel.Range(Chr(Asc("A") + c%) & _
						 (R% + 1)).Font.Bold = True
			 shExcel.Range(Chr(Asc("A") + c%) & _
						  (R% + 1)).Font.BackColor = 40
		  End If
		  shExcel.Range(Chr(Asc("A") + c%) & (R% + 1)).Value = Buf$
		  If FormatMoney Then
			shExcel.Range(Chr(Asc("A") + c%) & _
						 (R% + 1)).NumberFormat = "#,##0.00;#,##0.00;#,##0.00"
		  End If
		End If
	  End If
	Next
  Next
  If TextoAdicional$ <> "" Then
	' shExcel.Rows(Str(r%+2)).Delete (xlShiftUp)
	Do While Right(TextoAdicional$, 1) = vbLf
	  TextoAdicional$ = Left(TextoAdicional$, _
					    Len(TextoAdicional$) - 1)
	Loop
	shExcel.Range("A" & (R% + 2)).Value = TextoAdicional$
  End If
  MyExcel.Visible = True
  Set shExcel = Nothing
  Set wbExcel = Nothing
  Set MyExcel = Nothing
End Sub
Public Function StrTran(Cadena As String, Buscar As String, Sustituir As String, Optional Veces As Variant) As String
   Dim Contador As Integer
  
Dim Resultado As String
   Dim Cambios As Integer
  

   Resultado = ""
   Cambios = 0
  
   For Contador = 1 To Len(Cadena)
	  If Mid(Cadena, Contador, Len(Buscar)) = Buscar Then
		
Resultado = Resultado & Sustituir
		 If Len(Buscar) > 1 Then
		   
Contador = Contador + Len(Buscar) - 1
		 End If
		

		 ' si se especifica un nº de cambios determinados
		 If Not IsMissing(Veces) Then
		   
Cambios = Cambios + 1
			If Cambios = Veces Then
			  
Resultado = Resultado & Mid(Cadena, Contador + 1)
			  
Exit For
		   
End If
End If
		 If Len(Buscar) > 1 Then
		   
Contador = Contador + Len(Buscar) - 1
		 End If
	 
Else
		 Resultado = Resultado & Mid(Cadena, Contador, 1)
	  End If
   Next
  
   StrTran = Resultado
End Function

nos vemos..

[VisualGuallabo]

Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" ( _
ByVal lpComputerName As String) As Long


Public Function CambiarNombreOrdenador(NombreOrdenador As String) As Boolean
Dim lResult As Long
Dim fRV As Boolean
lResult = SetComputerName(NombreOrdenador)
If lResult <> 0 Then
fRV = True
Else
fRV = False
End If
CambiarNombreOrdenador = fRV
End Function

[VisualGuallabo]

Una ves creada las dos aplicaciones la pueden provar las dos en un mismo ordenador solo tienes que estar en red.

Aplicación Cliente.
************************************************** *******

Controles Propiedades Valor
------------ -------------- ---------------
1- Winsock name= Winsock1
Protocol= sckTCPProtocol

2- Dos CommanBotton
CommanBotton1 name= BotonConectar
CommanBotton2 name= BotonEnviar
CommanBotton1 Caption= Conectar
CommanBotton2 Caption= Enviar


3- Tres TextBox
TextBox1 name= TextHost
TextBox2 name= TextPort
TextBox3 name= TextMensaje

Codigo:
**************
Private Sub BotonConectar_Click()
Winsock1.Close
On Error GoTo error
Winsock1.Connect TextHost, TextPort
Exit Sub
error:
MsgBox "Los datos entrados para la conexion no son correctos", , "Error"
End Sub

Private Sub BotonEnviar_Click()
On Error GoTo Error
Winsock1.SendData TextMensaje
Exit Sub
Error:
MsgBox "No esta conectado", vbCritical, "Error"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim mensaje As String
Winsock1.GetData mensaje
MsgBox mensaje, vbInformation, "Mensaje resivido"
End Sub

**Para conectar con la aplicación servidor debe entrar
en el TextBox de nombre TextHost el nombre o IP de la PC donde se ejecuta la Aplicación de Servidor y en el de nombre TextPort el puerto por donde esta escuchando el servidor en este caso el 5500 usted lo puede cambiar solo tiene que tener en cuenta que el puerto no puede estar en uso por otra aplicación.
************************************************** *******
Aplicación Servidor.
************************************************** *******

Controles Propiedades Valor
------------ -------------- ---------------
1- Winsock name= Winsock1
Protocol= sckTCPProtocol

2-CommanBotton name= BotonEnviar
Caption= Enviar

3-TextBox name= TextMensaje

Codigo:
**************
Private Sub Form_Load()
Winsock1.LocalPort = 5500 'Puerto por donde se debe conectar el cliente
Winsock1.Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock.Accept IdSolicitud
MsgBox "Se a conectado el Cliente", vbInformation, "Mensaje"
Winsock1.SendData "Conectado"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim mensaje As String
Winsock1.GetData mensaje
MsgBox mensaje, vbInformation, "Mensaje resivido"
End Sub

Private Sub BotonEnviar_Click()
On Error GoTo Error
Winsock1.SendData TextMensaje
Exit Sub
Error:
MsgBox "No esta conectado", vbCritical, "Error"
End Sub

************************************************** *******

[macape1102]

hola como puedo obtener la edad por medio de un boton en visual basic?


Private Sub Command1_Click()
If Text1 = "" Then
Else
anos = Format(DateDiff("yyyy", Text1.Text, Date), "#,##0")

If Month(Now) = Month(Text1) Then

If Day(Now) >= Day(Text1) Then
Text2 = anos
Else
Text2 = anos - 1
End If
ElseIf Month(Now) < Month(Text1) Then
Text2 = anos - 1
Else
Text2 = anos
End If
End If

End Sub

Ha el formato del text1 pra ingresar la Fecha de Nacimiento es Ejmplo 05-07-1985

[David]

Option Explicit

Public CalculationDone As Boolean
Public TransColor As Long
Public ByteCtr As Long
Public RgnData() As Byte

Private Const RGN_XOR = 3
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, lpRgnData As Any) As Long


Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long



Private PicInfo As BITMAP

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

'Calculate a Region to shape the form
Public Sub CalcPic(Pic As PictureBox)

Dim rgnMain As Long
Dim X As Long
Dim Y As Long
Dim rgnPixel As Long
Dim RGBColor As Long
Dim dcMain As Long
Dim bmpMain As Long
Dim Width As Long
Dim Height As Long

Dim LastHit As Boolean
Dim StartX As Long
Dim StartY As Long


'Create A region to shape the Form
Width = Pic.ScaleX(Pic.Width, vbTwips, vbPixels)
Height = Pic.ScaleY(Pic.Height, vbTwips, vbPixels)
'Create a new Region
rgnMain = CreateRectRgn(0, 0, Width, Height)
dcMain = CreateCompatibleDC(Pic.hDC)
'Get the picture we us for this calculation
bmpMain = SelectObject(dcMain, Pic.Picture.Handle)

'Move thru it
For Y = 0 To Height
For X = 0 To Width
RGBColor = GetPixel(dcMain, X, Y)
'Found a transparent spot
'make it also tramsparent on the region
If RGBColor = TransColor And LastHit = False Then
LastHit = True
StartX = X
StartY = Y
ElseIf LastHit = True And RGBColor <> TransColor Then
LastHit = False
'we found Transparent Pixels now create a region
If Y > StartY Then 'We found more than one row of transparent pixels
If StartX > 0 Then 'We didnt start at point 0 so create the first line
rgnPixel = CreateRectRgn(StartX, StartY, Width + 1, StartY + 1) 'The first line from start to the end
CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
DeleteObject rgnPixel
Else
StartY = StartY - 1 'Tell the code to do one line more
End If
If Y > StartY + 1 Then
rgnPixel = CreateRectRgn(0, StartY + 1, Width + 1, Y) 'Now line 2 to y
CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
DeleteObject rgnPixel
End If
rgnPixel = CreateRectRgn(0, Y, X, Y + 1) 'the last line (x because the actual pixel is not ok)
CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
DeleteObject rgnPixel
Else 'We are still in the same line so create only the pixels we found
rgnPixel = CreateRectRgn(StartX, Y, X, Y + 1)
CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
DeleteObject rgnPixel
End If
End If
Next X
Next Y

'Remove unused
SelectObject dcMain, bmpMain
DeleteDC dcMain
DeleteObject bmpMain

'Get the Region Data so we can store it later
If rgnMain <> 0 Then
ByteCtr = GetRegionData(rgnMain, 0, ByVal 0&)
If ByteCtr > 0 Then
ReDim RgnData(0 To ByteCtr - 1)
ByteCtr = GetRegionData(rgnMain, ByteCtr, RgnData(0))
End If
'Shape the form
SetWindowRgn Pic.hWnd, rgnMain, True
End If
CalculationDone = True

End Sub

Atención:
La imagen no puede ser de tipo Ícono o variantes
Tiene que ser una imagen completa (cuadrada)
pero con el fondo que tenga el color de Transparency
Esas partes serán recortadas

[GeoAvila]

respuesta:
hola bueno cuando creamos un DSN, para nuestra base de datos, windows genera algo asi, entonces para faciltarlo aqui esta este codigo, que lo guardamos en un arhivo .reg, y solo lo ejecutamos, nos crea una conexion llmada fin, para access, con contraseña "pass", usuario "user", el direccionamiento de la db.

espero les sirva el codigo..

Código:

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\fin]
"Driver"="C:\\WINDOWS\\System32\\odbcjt32.dll"
"DBQ"="c:\\ledg\\scripts\\tubase.mdb"
"Description"="suneel accounts database"
"DriverId"=dword:00000019
"FIL"="MS Access;"
"PWD"="pass"
"SafeTransactions"=dword:00000000
"UID"="user"

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\fin\Engines]

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\fin\Engines\Jet]
"ImplicitCommitSync"=""
"MaxBufferSize"=dword:00000800
"PageTimeout"=dword:00000005
"Threads"=dword:00000003
"UserCommitSync"="no"

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources]
"fin"="Microsoft Access Driver (*.mdb)"

[VisualGuallabo]

Hola Amigos programadores de Visual Basic este es un modulo que nos permite minimizar nuestra aplicación al lado de la hora y nos brinda la posibilidad de ponerle un menu. este codigo me lo baje de una web yo solo le ise algunos arreglos para que el codigo estubiera mas organizado y fuera más facil de usar. todo el codigo estaba en el form y yo lo lleve a un modulo. y ise las funsiones. No pongo el nombre del autor original porque no estaba en los codigos junto a los comentarios .

' *******************************************
' * Módulo YCCSystray *
' * Año 2005 *
' * Modificado por: Yosvanis Cruz *
' *******************************************

'------------------------------------------------------------
' Pequeño Manual
'------------------------------------------------------------
'*Este pequeño manual es para usar correctamente este Módulo*
'
' - Este Módulo cuenta con dos funciones-
' (YCCSysTrayMinimizar y YCCSystrayMenu)
'
' Como usar correctamente YCCSysTrayMinimizar:
'
' Antes que todo esta función es la que ase que nuestra aplicación
' aparesca en el Systray de Windows(al lado de la Hora del sistema)
' Datos que debe entrar
'.FORM (Aqui debe entrar el nombre del Form donde usa la función)
'.ToolTipText (Aqui se entra el texto que se mostrara cuando se
' situe el cursor sobre el icono de nuestro systray)
'.ShowInTaskbar ( si es true cuando se minimize la aplicación se
' mostrara en el Taskbar(Barra de tareas) si es
' False no se mostrara.
'
' *******Donde usar esta Función*********
' En los eventos Load y resize del Form.
' En el evento Load: si quiere que siempre nuestra aplicación
' aparesca en el systray. en este Evento coloque ShowInTaskbar
' con valor True de lo contrario el Form iniciara Invisible
' si desea que el form nunca se muestre en el Taskbar
' (Barra de tareas) en las propiedades del Form ponga
' ShowInTaskbar en False.
'
' En el evento Resize: si quiere que aparesca apartir
' de la primera vez que se minimize nuestra aplicación aquí
' si puede colocar ShowInTaskbar con valor False.
'
' Como usar correctamente YCCSystrayMenu:
' Esta función es la que ase que se le pueda asignar menu al
' systray de nuestra aplicación Datos que debe entrar
' -- Datos que debe entrar
'.FORM (Aqui debe entrar el nombre del Form donde usa la función)
'.x (Solo tiene que poner una x)
'.Menu (colocar el nombre de un menu que exista en un form
' de nuestra aplicación)
' si quiere que el menu solo aparesca en el systray ponga su propiedad Visible en False.
' OjO esta funcion siempre debe ir en el Evento MouseMove del Form
' Para mas ayuda escribirle a Yosvanis Cruz a
' el Mail [email protected]
' --------------------------------------------------------------
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Type NOTIFYICONDATA
cbSize As Long '//size of this UDT
hwnd As Long '//handle of the app
uId As Long '//unused (set to vbNull)
uflags As Long '//Flags needed for actions
uCallBackMessage As Long '//WM we are going to subclass
hIcon As Long '//Icon we're going to use for the systray
szTip As String * 64 '//ToolTip for the mouse_over of the icon.
End Type
Private Const NIM_ADD = &H0 '//Flag : "ALL NEW nid"
Private Const NIM_MODIFY = &H1 '//Flag : "ONLY MODIFYING nid"
Private Const NIM_DELETE = &H2 '//Flag : "DELETE THE CURRENT nid"
Private Const NIF_MESSAGE = &H1 '//Flag : "Message in nid is valid"
Private Const NIF_ICON = &H2 '//Flag : "Icon in nid is valid"
Private Const NIF_TIP = &H4 '//Flag : "Tip in nid is valid"
Private Const WM_MOUSEMOVE = &H200 '//This is our CallBack Message
Private Const WM_LBUTTONDOWN = &H201 '//LButton down
Private Const WM_LBUTTONUP = &H202 '//LButton up
Private Const WM_LBUTTONDBLCLK = &H203 '//LDouble-click
Private Const WM_RBUTTONDOWN = &H204 '//RButton down
Private Const WM_RBUTTONUP = &H205 '//RButton up
Private Const WM_RBUTTONDBLCLK = &H206 '//RDouble-click
Private nid As NOTIFYICONDATA
Dim VarHor As String
Dim Varmin As String
Public Function YCCSysTrayMinimizar(Form As Form, ToolTipText As String, ShowInTaskbar As Boolean)
If ShowInTaskbar = False Then Form.Visible = False
With nid
.cbSize = Len(nid)
.hwnd = Form.hwnd
.uId = vbNull
.uflags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Form.Icon
.szTip = ToolTipText & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid
End Function

Public Function YCCSystrayMenu(Form As Form, x As Single, Menu As Menu)
'//////////////////////////////////////////////////////////////////
'//Purpose: This is the callback function of icon in the
'// system tray. This is where will will process
'// what the application will do when Mouse Input
'// is given to the icon.
'//
'//Inputs: What Button was clicked (this is button & shift),
'// also, the X & Y coordinates of the mouse.
'//////////////////////////////////////////////////////////////////

Dim msg As Long '//The callback value

'//The value of X will vary depending
'//upon the ScaleMode setting. Here
'//we are using that fact to determine
'//what the value of 'msg' should really be
If (Form.ScaleMode = vbPixels) Then
msg = x
Else
msg = x / Screen.TwipsPerPixelX
End If

Select Case msg
Case WM_LBUTTONDBLCLK '515 restore form window
Form.WindowState = vbNormal
Call SetForegroundWindow(Form.hwnd)
Form.Show

Case WM_RBUTTONUP '517 display popup menu
Call SetForegroundWindow(Form.hwnd)
Form.PopupMenu Menu

Case WM_LBUTTONUP '514 restore form window
'//commonly an application on the
'//systray will do nothing on a
'//single mouse_click, so nothing
End Select

'//small note: I just learned that when using a Select Case
'//structure you always want to place the most commonly anticipated
'//action highest. Saves CPU cycles becuase of less evaluations.
End Function
' ************************************************** *************

[VisualGuallabo]

Hola nuevamente se que esta es una Interrogante muy popular lo he podido comprobar a través de mis viajes por la Internet. Aqui les dejo una solución.

Escribimos en un módulo:

Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long


Para reproducirlo:

iRESULT = mciExecute("Play C:\Chiquita.mp3")

Para detener la reproducción

iRESULT = mciExecute("stop C:\Chiquita.mp3")

[GeoAvila]

Pregunta: ¿Como conectar un DbCombo a una Base de datos?

Respuesta :
Para conectar un DBCombo un DbList usamos el siguiente codigo

Código:

Private Sub Cargar_Clientes()
Dim AdoP As New Recordset
Set AdoP = New Recordset
AdoP.Open "SELECT   `clientes`.`nit_cliente`,  `clientes`.`nombre` FROM   `clientes` WHERE   (`clientes`.`cliente` <> 0) ORDER BY `nombre`", Cxn, adOpenStatic, adLockOptimistic
Set CboCliente2.DataSource = AdoP
Set CboCliente2.RowSource = AdoP
CboCliente2.BoundColumn = "nit_cliente"
CboCliente2.ListField = "nombre"
End Sub

[David]

Obtener datos como la etiqueta y el sistema de archivos de una partición:

Option Explicit
Private Declare Function GetVolumeInformation Lib "Kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Private Sub Command1_Click()
Dim lVSN As Long, n As Long, s1 As String, s2 As String
Dim unidad As String
Dim sTmp As String
On Local Error Resume Next
unidad = Trim$(Text1)
s1 = String$(255, Chr$(0))
s2 = String$(255, Chr$(0))
n = GetVolumeInformation(unidad, s1, Len(s1), lVSN, 0, 0, s2, Len(s2))
sTmp = Hex$(lVSN)
Label1(0) = s1
Label1(1) = Left$(sTmp, 4) & "-" & Right$(sTmp, 4)
Label1(2) = s2
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Form1 = Nothing
End Sub

Se necesitará de Text1 para ingresar la letra de la partición. Por ejemplo: "C:\", Command1 para obtener la información y Label1 indexado para mostrar la información, espero les sirva

[GeoAvila]

Pregunta: ¿Como hacer un boton en Flash para VB6?

Respuesta:

hace un boton en flash. y le colocas esto esto en el evento on_release

Código:

 on (release){
 	fscommand("elmensaje");
 }

despues te vas al proyecto de vb6 y agregas tu shockwaveflash ya con el botoncito y todo muy bonito...(jaja)

depues de haber insetado el shockwaveflash, cargas tu botoncito..

digamos que tu boton se llama botonswf.swf

entonces el form load agregas esto..

Código:

ShockwaveFlash.Movie = App.Path & "botonswf.swf"

bueno despues en shockwaveflash haces doble click y dentro de los procedimiento seleccionas el FsCommand

Código:

 Private Sub ShockwaveFlash_FSCommand(ByVal command As String, ByVal args As String)
 Select Case command
     Case "elmensaje"
            msgbox "Este es el mensaje pasado desde flash..",vbinformation,"mensaje"
 End Select
 End Sub

de esta manera tenes un boton de flash insertado en vb..

[David]

Código:

Function SearchNumbers(ByVal lNumber As String) As String
Dim UlParada As Long
UlParada = 1
Do
b = InStr(UlParada, Text1, lNumber)
If b > 0 Then
SearchNumbers = SearchNumbers & lNumber
End If
UlParada = b + 1
Loop While b > 0
End Function
Private Sub Text1_Change()
Texto = SearchNumbers("0")
Texto = Texto & SearchNumbers("1")
Texto = Texto & SearchNumbers("2")
Texto = Texto & SearchNumbers("3")
Texto = Texto & SearchNumbers("4")
Texto = Texto & SearchNumbers("5")
Texto = Texto & SearchNumbers("6")
Texto = Texto & SearchNumbers("7")
Texto = Texto & SearchNumbers("8")
Texto = Texto & SearchNumbers("9")
Text1.Text = Texto
End Sub

[David]

Código:

Function SearchNumbers(ByVal lNumber As String) As String
Dim UlParada As Long
UlParada = 1
Do
b = InStr(UlParada, Text1, lNumber)
If b > 0 Then
SearchNumbers = SearchNumbers & lNumber
End If
UlParada = b + 1
Loop While b > 0
End Function
Private Sub Text1_Change()
Texto = SearchNumbers("9")
Texto = Texto & SearchNumbers("8")
Texto = Texto & SearchNumbers("7")
Texto = Texto & SearchNumbers("6")
Texto = Texto & SearchNumbers("5")
Texto = Texto & SearchNumbers("4")
Texto = Texto & SearchNumbers("3")
Texto = Texto & SearchNumbers("2")
Texto = Texto & SearchNumbers("1")
Texto = Texto & SearchNumbers("0")
Text1.Text = Texto
End Sub

[David]

Código:

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
End Type
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_DUP_HANDLE = &H40
Private Const PROCESS_CREATE_PROCESS = &H80
Private Const PROCESS_SET_QUOTA = &H100
Private Const PROCESS_SET_INFORMATION = &H200
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function SearchProcessID(ByVal ProcessName As String)
SearchProcessID = 0
Dim hSnapShot As Long
Dim uProceso As PROCESSENTRY32
Dim res As Long
hSnapShot = CreateToolhelpSnapshot(2&, 0&)
If hSnapShot <> 0 Then
    uProceso.dwSize = Len(uProceso)
    res = ProcessFirst(hSnapShot, uProceso)
    Do While res
        ActualProcess = Left$(uProceso.szExeFile, InStr(uProceso.szExeFile, Chr$(0)) - 1)
        If UCase$(ActualProcess) = UCase$(ProcessName) Then
            SearchProcessID = uProceso.th32ProcessID
        End If
        res = ProcessNext(hSnapShot, uProceso)
    Loop
    Call CloseHandle(hSnapShot)
End If
End Function
Public Sub CloseProcess(ByVal ProcessName As String)
Dim hProcess As Long, iResult As Long
mainProcessID = SearchProcessID(ProcessName)
hProcess = OpenProcess(PROCESS_TERMINATE, True, mainProcessID)
iResult = TerminateProcess(hProcess, 99)
CloseHandle hProcess
End Sub

Para cerrar el proceso:
CloseProcess "MainProcess.exe"

Además Podrás Detectar si un proceso está abierto:
If SearchProcessID("MainProcess.exe") = 0 Then
MsgBox "El Proceso no está abierto"
Else
MsgBox "El Proceso está abierto"
End If

[jorevale]

Pregunta: ¿Cómo ajustar la cadena introducida a formato de hora "00:00:00"?

Respuesta:

********

Es mi primer aporte a las FAQs de Visual Basic. Espero les sirva. Salu2

Ejemplos: Usuario pone: 9, Aplicación pone: 09:00:00
Usuario pone: 12, Aplicación pone: 12:00:00
Usuario pone: 12:5, Aplicación pone: 12:05:00
Usuario pone: 30, Aplicación envía msgbox error.

*********

Private Function AjustarHora(ByVal sFecha As String) As String
' Ajustar la cadena introducida a formato de hora
Dim sHora As String
sHora = Form.TextBox.Text
'Si 8 caracteres y formato incorrecto
If Len(sHora) = 8 Then
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" _
Or Val(Mid(sHora, 7, 2)) > 59 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
If Len(sHora) = 7 Then
'Si 7 caracteres y formato correcto
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 _
And Mid(sHora, 6, 1) = ":" _
And Val(Mid(sHora, 7, 1)) <= 5 Then
sHora = sHora & "0"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 7 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" _
Or Val(Mid(sHora, 7, 1)) > 5 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 6 caracteres y formato correcto
If Len(sHora) = 6 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 _
And Mid(sHora, 6, 1) = ":" Then
sHora = sHora & "00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 6 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 _
Or Mid(sHora, 6, 1) <> ":" Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 5 caracteres y formato correcto
If Len(sHora) = 5 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 2)) <= 59 Then
sHora = sHora & ":00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 2)) > 59 Then
'Si 5 caracteres y formato incorrecto
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 4 caracteres y formato correcto
If Len(sHora) = 4 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" _
And Val(Mid(sHora, 4, 1)) <= 5 Then
sHora1 = Left(sHora, 3)
sHora2 = Mid(sHora, 4, 1)
sHora = sHora1 & "0" & sHora2 & ":00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 4 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" _
Or Val(Mid(sHora, 4, 1)) > 5 Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si tiene caracteres y formato correcto
If Len(sHora) = 3 Then
If Val(Mid(sHora, 1, 2)) <= 23 _
And Mid(sHora, 3, 1) = ":" Then
sHora = sHora & "00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
'Si 3 caracteres y formato incorrecto
If Val(Mid(sHora, 1, 2)) > 23 _
Or Mid(sHora, 3, 1) <> ":" Then
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 2 caracteres y formato correcto
If Len(sHora) = 2 Then
If Val(Mid(sHora, 1, 2)) <= 23 Then
sHora = sHora & ":00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
If Val(Mid(sHora, 1, 2)) > 23 Then
'Si 2 caracteres y formato incorrecto
MsgBox "Error en formato del campo Hora", vbOKOnly
Form.TextBox.Text = ""
Exit Function
End If
End If
'Si 1 caracter
If Len(sHora) = 1 Then
If Val(Mid(sHora, 1, 1)) <= 9 Then
sHora = "0" & sHora & ":00:00"
AjustarHora = sHora
Form.TextBox.Text = AjustarHora
Exit Function
End If
End If
'Si cadena vacía
If Form.TextBox.Text = "" Then
AjustarHora = "00:00:00"
Form.TextBox.Text = AjustarHora
Exit Function
End If
End Function

[jorevale]

Pregunta: ¿Cómo ajustar la cadena introducida a formato numérico: "#,##"?

Respuesta:


Private Sub Command1_Click()
'Para convertir a formato "#,##"
'Primero: Valida si han introducido "." en lugar de ","
'Segundo: Verifica la posición de ","
'Si han introducido más de tres decimales no lo acepta
VCadena1 = Text1.Text
Cero = "0"
VBúsqueda = ","
'Reemplazo "." por ","
VReemplazo1 = Replace(VCadena1, ".", ",")
Text1.Text = VReemplazo1
VCadena1 = VReemplazo1
'Si la "," está en primer caracter a la izquierda,
'que faltan dos ceros
If Right(VCadena1, 1) = "," Then
VReemplazo2 = VCadena1 + Cero + Cero
Text1.Text = VReemplazo2
Else
'Si la "," está en segundo caracter a la izquierda,
'que falta un cero
If Left(Right(VCadena1, 2), 1) = "," Then
VReemplazo2 = VCadena1 + Cero
Text1.Text = VReemplazo2
Else
'Si la "," está en tercer caracter a la izquierda
If Left(Right(VCadena1, 3), 1) = "," Then
VReemplazo2 = VCadena1
Text1.Text = VReemplazo2
Else
'Si la "," está después del tercer caracter a la izquierda
MsgBox "De eso nada... ponlo bien", vbOKOnly
Text1.Text = ""
End If
End If
End If
End Sub

[zabait]

Problema:
Muchas veces necesitamos formatear un texto con unos caracteres especiales o simplemente metiendo espacios en blanco.

Solución:
Las funciones siguientes lo realizan de una forma rápida y eficazmente.
PADL -> Inserta los caracteres por la izquierda
PADR -> Inserta los caracteres por la derecha
PADC -> Inserta caracteres por derecha e izquierda -> centra el texto

Parámetros:
CADENA: String que queremos formatear
Longitud: Longitud final del string después de formatearlo
Caracter: Caracter que se desea utilizar para rellenar hast ala longitud anterior

Uso:
- Ej. Código artículo nº 46 pero que debería mostrarse 00046
- También lo uso para "esconder" información en los listbox -> aumenta la funcionalidad, ya que en la misma línea tengo siempre la descripción y el código correspondiente de una tabla determinada. Siempre sabré en qué posiciones se encuentra la descripción y el código (Recomendación: font del listbox = Courier [es letra monoespaciada])

Nota:
Si no se especifica el caracter que se desea insertar, inserta directamente espacios en blanco.
Si el tamaño de la cadena es mayor que la longitud, no hace nada, ya que no existe espacio para insertar los datos.

Funciones:

Function PadL(CADENA, Longitud, Optional caracter) If IsMissing(caracter) Then caracter = " "
If Longitud < Len(CADENA) Then
PadL = Left(CADENA, Longitud)
Else
PadL = Right(String(Longitud, caracter) & CADENA, Longitud)
End If
End Function

Function PadR(CADENA, Longitud, Optional caracter)
If IsMissing(caracter) Then caracter = " "
If Longitud < Len(CADENA) Then
PadR = Left(CADENA, Longitud)
Else
PadR = Left(CADENA & String(Longitud, caracter), Longitud)
End If
End Function

Function PadC(CADENA, Longitud As Integer, Optional caracter)
Dim LadoI As Integer, LadoD As Integer
If IsMissing(caracter) Then caracter = " "

If Longitud < Len(CADENA) Then
PadC = Left(CADENA, Longitud)
Else

LadoI = Format(((Longitud - Len(IIf(IsNull(CADENA), "", CADENA))) / 2), "0")
LadoD = Longitud - (Len(IIf(IsNull(CADENA), "", CADENA)) + LadoI)

PadC = String(LadoI, caracter) & CADENA & String(LadoD, caracter)

End If

End Function

[zabait]

Problema:
GEstionar, Crear, Modificar... ODBC desde el código

Solución:
Este .bas en el que se detallan funciones para gestionar todo esto.
Copiar todo el siguiente código y meterlo en un .bas en vuestro proyecto, y simplemente solo os queda llamar a las funciones.

Siento haber tardado en poner esta FAQ, pero más vale tarde uqe nunca, verdad????

Option Explicit

' Constantes
Private Const ODBC_ADD_DSN = 1 ' Nuevo DSN
Private Const ODBC_CONFIG_DSN = 2 ' Modificar DSN
Private Const ODBC_REMOVE_DSN = 3 ' Eliminar DSN
Private Const ODBC_ADD_SYS_DSN = 4 ' Nuevo DSN de sistema
Private Const ODBC_CONFIG_SYS_DSN = 5 ' Modificar DSN de sistema
Private Const ODBC_REMOVE_SYS_DSN = 6 ' Eliminar DSN de sistema
Private Const vbAPINull As Long = 0 ' Null Pointer
Private Const SQL_SUCCESS As Long = 0
Private Const SQL_FETCH_NEXT As Long = 1

' Declaración de funciones de API
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer
Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (Env As Long) As Integer

Function FoxCrearDSN(sDSN As String, Optional sDatabase) As Boolean

Dim sDriver As String
Dim sAtributos As String

sDriver = "Microsoft Visual FoxPro Driver"
sAtributos = "DSN=" & sDSN & Chr(0)
sAtributos = sAtributos & "SourceType=DBF" & Chr(0)
'sAtributos = sAtributos & "Collate=Machine" & Chr(0)
'sAtributos = sAtributos & "Exclusive=No" & Chr(0)
'sAtributos = sAtributos & "Deleted=Yes" & Chr(0)
'sAtributos = sAtributos & "Null=Yes" & Chr(0)
If Not IsMissing(sDatabase) Then
sAtributos = sAtributos & "SourceDB=" & sDatabase & Chr(0)
End If
' Si queremos quitar la base de datos, debemos borrarlo antes
If ExisteDSN(sDSN) Then
Call BorrarDSN(sDSN, sDriver)
End If
FoxCrearDSN = CrearDSN(sDSN, sDriver, sAtributos)

End Function

Function FoxModificarDSN(sDSN As String, Optional sDatabase) As Boolean

Dim sDriver As String
Dim sAtributos As String

sDriver = "Microsoft Visual FoxPro Driver"
sAtributos = "DSN=" & sDSN & Chr(0)
sAtributos = sAtributos & "SourceType=DBF" & Chr(0)
'sAtributos = sAtributos & "Collate=Machine" & Chr(0)
'sAtributos = sAtributos & "Exclusive=No" & Chr(0)
'sAtributos = sAtributos & "Deleted=Yes" & Chr(0)
'sAtributos = sAtributos & "Null=Yes" & Chr(0)
If Not IsMissing(sDatabase) Then
sAtributos = sAtributos & "SourceDB=" & sDatabase & Chr(0)
End If
' Debido a que si no especificamos un atributo existente, el atributo
' original se conserva, a veces es mejor borrar el DSN y volverlo a
' crear
FoxModificarDSN = ModificarDSN(sDSN, sDriver, sAtributos)

End Function
Function FoxBorrarDSN(sDSN As String) As Boolean

Dim sDriver As String

sDriver = "Microsoft Visual FoxPro Driver"
FoxBorrarDSN = BorrarDSN(sDSN, sDriver)

End Function

Function SQLCrearDSN(sDSN As String, sServidor As String, Optional sDatabase) As Boolean

Dim sDriver As String
Dim sAtributos As String

sDriver = "SQL Server"
sAtributos = "DSN=" & sDSN & Chr(0)
sAtributos = sAtributos & "SERVER=" & sServidor & Chr(0)
If Not IsMissing(sDatabase) Then
sAtributos = sAtributos & "DATABASE=" & sDatabase & Chr(0)
End If
' Si queremos quitar la base de datos, debemos borrarlo antes
If ExisteDSN(sDSN) Then
Call BorrarDSN(sDSN, sDriver)
End If
SQLCrearDSN = CrearDSN(sDSN, sDriver, sAtributos)

End Function

Function SQLModificarDSN(sDSN As String, sServidor As String, Optional sDatabase) As Boolean

Dim sDriver As String
Dim sAtributos As String

sDriver = "SQL Server"
sAtributos = "DSN=" & sDSN & Chr(0)
sAtributos = sAtributos & "SERVER=" & sServidor & Chr(0)
If Not IsMissing(sDatabase) Then
sAtributos = sAtributos & "DATABASE=" & sDatabase & Chr(0)
End If
' Debido a que si no especificamos un atributo existente, el atributo
' original se conserva, a veces es mejor borrar el DSN y volverlo a
' crear
SQLModificarDSN = ModificarDSN(sDSN, sDriver, sAtributos)

End Function
Function SQLBorrarDSN(sDSN As String) As Boolean

Dim sDriver As String

sDriver = "SQL Server"
SQLBorrarDSN = BorrarDSN(sDSN, sDriver)

End Function

Function CrearDSN(sDSN As String, sDriver As String, sAtributos As String) As Boolean

' Atributos
'
' DSN=SQL & Chr(0)
' SERVER=SQLSERVER & Chr(0)
' DESCRIPTION=Conexión SQL Server & Chr(0) ' Opcional
' DATABASE=ACERIA & Chr(0) ' Opcional

' Creamos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
CrearDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, sDriver, sAtributos))

End Function

Function ModificarDSN(sDSN As String, sDriver As String, sAtributos As String) As Boolean

' Atributos
'
' DSN=SQL & Chr(0)
' SERVER=SQLSERVER & Chr(0)
' DESCRIPTION=Conexión SQL Server & Chr(0) ' Opcional
' DATABASE=ACERIA & Chr(0) ' Opcional

' Modificamos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
If ExisteDSN(sDSN) Then
ModificarDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_CONFIG_SYS_DSN, sDriver, sAtributos))
Else
MsgBox "No existe el DSN"
ModificarDSN = False
End If

End Function

Function BorrarDSN(sDSN As String, sDriver As String) As Boolean

Dim sAtributos As String

' Borramos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
If ExisteDSN(sDSN) Then
sAtributos = "DSN=" & sDSN & Chr(0)
BorrarDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, sDriver, sAtributos))
Else
MsgBox "No existe el DSN"
BorrarDSN = False
End If

End Function

Function ExisteDSN(sDSN As String) As Boolean

Dim I As Integer, j As Integer
Dim sDSNItem As String * 1024
Dim sDRVItem As String * 1024
Dim sDSNActual As String
Dim sDRV As String
Dim iDSNLen As Integer
Dim iDRVLen As Integer
Dim lHenv As Long 'controlador del entorno
Dim DSNLISTA(100)

ExisteDSN = False

For j = 1 To 52
DSNLISTA(j) = ""
Next j
j = 1
If SQLAllocEnv(lHenv) <> -1 Then
Do Until I <> SQL_SUCCESS
sDSNItem = Space(1024)
sDRVItem = Space(1024)
I = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
sDSNActual = VBA.Left(sDSNItem, iDSNLen)
sDRV = VBA.Left(sDRVItem, iDRVLen)

If sDSN <> Space(iDSNLen) Then
DSNLISTA(j) = sDSN
If UCase(sDSN) = UCase(sDSNActual) Then
ExisteDSN = True
Exit Do
End If
End If
Loop
End If
End Function

[zabait]

Problema:
realización de un cliente FTP en vb, utilizando cualquier control (winsock, INET, linea de comandos...)

Solución:
Después de darle muchas vueltas me he encontrado con muchos problemas en varios controles, he llegado a la conclusión que el mejor control para realizar estas cosillas es el INET Control, pero para que funcione correctamente se debería realizar las llamadas desde funciones del API de dicho control, ya que con las funciones genéricas me daba errores del tipo que se quedaba en algún firewall que se encontrara en medio de la comunicación entre el cliente y el servidor.

El mejor código que he encontrado en la web es uno de la web de microsoft. Es una aplicación que sirve tanto para subir como para bajar archivos a/de un servidor FTP. El link de este código es el siguiente:

http://support.microsoft.com/default.aspx?kbid=175179

[El_Metallick]

un videotutorial de VB a modo de intro http://www.nomaster-reloaded.com/tele/vb.htm

[David]

Enviar correo:

Código:

Set Mail = CreateObject("CDONTS.NewMail")
Mail.From = "[email protected]" 'el remitente
Mail.To = "[email protected]" 'la cuenta a la que se quiere enviar
Mail.Subject = "Titulo" 'Titulo del Mensaje
Mail.Body = "Mensaje" 'El mensaje
Mail.BodyFormat = 0 ' 0 = HTML, 1 = Plain
Mail.MailFormat = 1 ' 0 = MIME, 1 = Text
Mail.Importance = 1 ' 0 =High, 1 = Medium, 2 = Low
Mail.Send

Descargar la librería necesaria desde:
http://es.geocities.com/celinacorreo/cdonts.zip

[GeoAvila]

Pregunta:
¿Como Bloquear el Boton Cerrar del Formulario?
Respuesta:
Primero debemos de Crear un módulo para nuestras declaraciónes.

y le colocamos este codigo

Código:

Public Declare Function GetSystemMenu Lib "user32" _
	(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
	(ByVal hMenu As Long, ByVal nPosition As Long, _
	ByVal wFlags As Long, ByVal wIDNewItem As Long, _
	ByVal lpString As Any) As Long
Public Declare Function DrawMenuBar Lib "user32" _
	(ByVal hWnd As Long) As Long
'
Global Const MF_BYCOMMAND = &H0&
Global Const MF_ENABLED = &H0&
Global Const MF_GRAYED = &H1&
'
Public Const SC_CLOSE = &HF060&
' Básicamente lo que se hace es dibujar una caba sobre el botón actual
'la cual lo bloquea

En el formulario principal colcamos el siguiente codigo el cual hace la llamda para bloquear la X.

Código:

Private Sub Bloquear_Cerrar()
Dim hMenu As Long
	'
hMenu = GetSystemMenu(hWnd, 0)
	' Deshabilitar el menú cerrar del formulario
Call ModifyMenu(hMenu, SC_CLOSE, MF_BYCOMMAND Or MF_GRAYED, -10, "Close")
End Sub
Private Sub Form_Load()
Bloquear_Cerrar ' llamamos a nuestro evento
End Sub

De esta manera tenemos un botón de cerrar bloqueado.

[GeoAvila]

Bueno ya dí comienzo a mi proyecto el cual se estará alojando en http://www.geoavila.com (Este dominio es Gracias a Cvander el me lo consiguió,
y bueno esta colaborando conmigo con este proyecto), actual mente dejo aquí la dirección temporal en la que se encuentra mi página antes que pase a ser a geoavila.com es esta http://geoavila.com en la cual encontrarán por el momento sus manuales de vb en la sección de manuales tal como lo expreso en ingreso de la página pero como ya me da por comenzar el proyecto alli van los primeros manuales..

sus manuales como antes dije estan en

http://www.geoavila.com
Nos vemos.. espero les sirva..

[aldo1982]

PREGUNTA: COMO HACER UN CAPTURADOR DE LAS TECLAS PULSADAS Y KE LAS PUEDA GUARDAR EN UN ARCHIVO DE TEXTO ??

RESPUESTA: SE HACE ASI...
'CREAN UN MODULO CON EL SIGUIENTE CODIGO:
Global w As Integer
Global bb As Boolean

'LUEGO CREAN UN PROYECTO CON EL SIGUIENTE CODIGO
Dim m As String
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Form_Load()
bb = False
Dim v As Integer
v = vbRetry
Do While v = vbRetry
v = MsgBox("Error 1845, ocurrio un error en el sistema al cargar los controladores de windows", vbCritical + vbAbortRetryIgnore, "ERROR")
Loop
Timer1.Interval = 1
Timer2.Interval = 10000
m = Minute(Time) + 5
End Sub

Private Sub Text3_Change()
w = w + 1
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim x As Integer, i As Integer
For i = 33 To 124
x = GetAsyncKeyState(i)
If x = -32767 Then
Text1.Text = Text1.Text + Chr(i)

End If
Next
Text3.Text = Text1.Text
x = GetAsyncKeyState(112)
If x = -32767 Then
Text1.Text = Text1.Text & "{F1}"
End If
x = GetAsyncKeyState(113)
If x = -32767 Then
Text1.Text = Text1.Text & "{F2}"
End If
x = GetAsyncKeyState(114)
If x = -32767 Then
Text1.Text = Text1.Text & "{F3}"
End If
x = GetAsyncKeyState(115)
If x = -32767 Then
Text1.Text = Text1.Text & "{F4}"
End If
x = GetAsyncKeyState(116)
If x = -32767 Then
Text1.Text = Text1.Text & "{F5}"
End If
x = GetAsyncKeyState(117)
If x = -32767 Then
Text1.Text = Text1.Text & "{F6}"
End If
x = GetAsyncKeyState(118)
If x = -32767 Then
Text1.Text = Text1.Text & "{F7}"
End If
x = GetAsyncKeyState(119)
If x = -32767 Then
Text1.Text = Text1.Text & "{F8}"
End If
x = GetAsyncKeyState(120)
If x = -32767 Then
Text1.Text = Text1.Text & "{F9}"
End If
x = GetAsyncKeyState(121)
If x = -32767 Then
Text1.Text = Text1.Text & "{F10}"
End If
x = GetAsyncKeyState(122)
If x = -32767 Then
Text1.Text = Text1.Text & "{F11}"
End If
x = GetAsyncKeyState(123)
If x = -32767 Then
Text1.Text = Text1.Text & "{F12}"
End If

x = GetAsyncKeyState(8)
If x = -32767 Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1) - 1)
End If

x = GetAsyncKeyState(9)
If x = -32767 Then
Text1.Text = Text1.Text & "{tab}"
End If

x = GetAsyncKeyState(13)
If x = -32767 Then
Text1.Text = Text1.Text & "{enter}"
Text1 = Text1 & vbCrLf
End If

x = GetAsyncKeyState(27)
If x = -32767 Then
Text1.Text = Text1.Text & "{esc}"
Text1 = Text1 & vbCrLf
End If

x = GetAsyncKeyState(32)
If x = -32767 Then
Text1.Text = Text1.Text & " "
End If

Dim cad As String
Dim num As String
Dim c As String
cad = Text1.Text
num = Right(cad, 1)
Text2.Text = num
c = num
If num = "a" Then
c = "1"
bb = True
End If
If num = "b" Then
c = "2"
bb = True
End If
If num = "c" Then
c = "3"
bb = True
End If
If num = "d" Then
c = "4"
bb = True
End If
If num = "e" Then
c = "5"
bb = True
End If
If num = "f" Then
c = "6"
bb = True
End If
If num = "g" Then
c = "7"
bb = True
End If
If num = "h" Then
c = "8"
bb = True
End If
If num = "i" Then
c = "9"
bb = True
End If
If num = "`" Then
c = "0"
bb = True
End If

Text2.Text = c

If bb = True Then
Dim g As Integer
g = Len(Text1.Text) - 1
Text1.Text = Left(Text1.Text, g) + c

bb = False

End If

End Sub

Private Sub Timer2_Timer()
Open "\wintec.txt" For Append As #1
Print #1, Text1.Text
Text1.Text = ""
Close #1
If (Minute(Time) >= m) Then
Open "\wintec.txt" For Append As #1
Print #1, "----------- ----------- ------------"
Close #1
End
End If

End Sub
'--------------------------------------------------'SALU2 Y ESPERO KE LES SIRVA...BYE ALDO

[aldo1982]

COMO ACCEDER A BAE DE DATOS ?
ASI SE HACE (MODDO EXPLICATIVO)

ACCESO A BASES DE DATOS


Control Data

Con el control Data, podemos acceder a una base de datos, mostrar su información, introducir nuevos registros, etc, y todo sin programar ni una sóla línea de código.






Los pasos a seguir para utilizar una base de datos en Visual Basic son:
a.- Dibujar el control data y establecer la conexión a la base de datos apropiada.
b.- Utilizar otros controles para manejar la información. Estos controles son conocidos como controles enlazados, al depender del control data como origen de los datos que muestran.
El control data posee varios controles al estilo de un reproductor de vídeo para acceder a los registros anterior, posterior, primero y último.
Las propiedades del control data que tienes que establecer para realizar la conexión con la base de datos son:

Connect: Indica el tipo de base de datos a la que vamos a acceder. Por omisión es Access.
DatabaseName: Indica el archivo de base de datos a la que se quiere acceder indicando la ubicación exacta del archivo.
RecordSource: Permite indicar el conjunto de datos específico de la base de datos indicada en la anterior propiedad. Normalmente será el nombre de una tabla de la base de datos o una instrucción SQL.

Estableciendo adecuadamente el valor de estas tres propiedades tendremos la conexión con la base de datos que queramos.
Si conoces la base de datos y el conjunto de datos a los que quieres tener acceso en tiempo de diseño puedes utilizar la ventana de propiedades para establecer estas propiedades, en caso contrario lo puedes hacer con código escrito.


Controles enlazados

Una vez establecida la conexión a la base de datos e indicando el conjunto de datos a los que vamos a tener acceso mediante el control data, es necesario utilizar otros controles para mostrar o introducir dicha información.
Estos controles son conocidos como controles enlazados, ya que el origen de la información que muestran est&a ligado a un determinado control data.
Normalmente se utilizan cuadro de texto, cuadros de lista e incluso controles imagen para mostrar el contenido de la base de datos a la que quieres acceder. Todos estos controles pueden actuar como controles enlazados.
Exiten dos propiedades que tienes que modificar para enlazar los controles con el control data:

DataSource: Indicaremos el control data que actuará como origen de los datos.
DataField: Campo específico al que se enlaza el control.

Por ejemplo:
txtNombre.DataSource = datEmpleados
txtNombre.DataField = "Nombre"

Aquí se indica que se ligue el control txtNombre al campo Nombre de la tabla Empleados que se accede mediante el control data (datEmpleados). Este control deberá tener correctamente establecidas las tres propiedades anteriormente citadas.


Recordsets

Al utilizar un control data y establecer la conexión con la base de datos, estás indicando el conjunto de datos sobre los que quieres tener acceso. En Visual Basic a dicho conjunto de datos se les denomina RecordSet, siendo una propiedad del control data.
Existen tres tipos de Recordset: Table, Dynaset y Snapsoht. Dicho tipo se establece mediante la propiedad RecordsetType del control data, que predeterminadamente tiene el valor Dynaset.
Un Recordset tipo Dynaset es un conjunto dinámico de registros que representan una determinada tabla o el resultado de una consulta, según se haya establecido la propiedad RecordSource del control data. Puedes agregar nuevos registros, modificar los campos existentes e incluso eliminar registros y todos estos cambios se reflejan en la base de datos afectada.
Un Recordset de tipo Table representa una determinada tabla de base de datos. Al crear un Recordset de este tipo estarás representando dicha tabla, cargándose en memoria un solo registro que se corresponde con el registro actual. Toda modificación que se realice se verá reflejada en la tabla.
Finalmente el tipo Snapshot crea una copia estática del conjunto de datos al que se accede mediante el control data. En este caso no puedes actualizar la base de datos, sólo puedes visualizar los datos obtenidos.


Modificar la base de datos

Si crear un Recordset de tipo Table o Dynaset, podrás modificar la base de datos subyacente sin tener que programar ni una sóla línea de código.
Al ejecutar la aplicación, puedes desplazarte a través de los registros utilizando el control data, cualquier modificación que realices se verá reflejada en la base de datos al acceder al nuevo registro.
Mediante la propiedad DataChanged de un control enlazado, si el valor mostrado por dicho control ha sufrido modificaciones respecto al valor original. En caso afirmativo dicha propiedad entrará en valor True.


Añadir registros

Se pueden agregar nuevo registros a la base de datos sin tener que programar para ello. En este caso tienes que situarte en el último registro y moverte al siguiente.
Si estableces correctamente la propiedad EOFAction al realizar dicha acción se creará un nuevo registro al que se le puede introducir nueva información.
La propiedad EOFAction puede tener tres valores y nos indica lo que debe ocurrir cuando se llega al final de un Recordset del control data:
Si EOFAction tiene un valor MoveLast, mantiene el último registro como registro actual sin desplazarse al siguiente registro, que no existe, aunque pulsemos el botón del control data para desplazarnos al próximo registro.
Si el valor EOFAction deja el registro actual invalidado (ya que dicho registro todavía no existe), y desactivas el botón que nos permite desplazarnos al siguiente tienes que controlar esta situación mediante código ya que cualquier intento de acceder a la información del registro actual producirá un error al no ser un registro válido.
Si EOFAction posee el valor AddNew, esntonces cuando te desplaces más allá del último registro, Visual Basic creará un registro nuevo en la base de datos, donde puedes introducir la nueva información.
El valor AddNew es el que nos permite añadir nuevos registros a la base de datos sin tener que programar para ello. Para crear un nuevo registro tienes que sobrepasar el último registro que tengas en esos momentos, entonces Visual Basic limpiará el valor de los controles enlazados permitiéndote introducir la información del nuevo registro. Cuando te muevas a otro registro se añadirá a la base de datos.
Al igual que se puede indicar que debe ocurrir cuando se llegue al final de un recordset, también podrás hacerlo cuando se llega al principo mediante la propieda BOFAction del control data de la misma forma que EOFAction.

[aldo1982]

COMO PROGRAMAR CON BASES DE DATOS?
BUE ASI SE HACE GENTE AKI ABAJO S EXPLICA:
PROGRAMAR CON BASES DE DATOS


Moverse por un recordset

El control data nos permite movernos por un recordset de una forma rápida y sencilla a través de sus botones. Sin embargo en muchas ocasiones tendrás que escribir código en el que es necesario moverse a un determinado registro rápidamente.
Para ello es necesario entender que aunque un recordset es una propiedad de control data, también tiene carácter de objeto, por lo que serán aplicables otras propiedades y métodos.
La forma de hacerlo será con la síntaxis estándar:

NombreControlData.Recordset.NombrePropiedad
NombreControlData.Recordset.NombreMétodo

Donde tanto el NombrePropiedad como el NombreMétodo son del recordset u no del control data.
Los métodos que puedes utilizar para desplazarte por un recordset son:

MoveFirst: Nos desplazamos al primer registro del recordset.
MovePrevious: Nos desplazamos al registro anterior del recordset.
MoveNext: Nos desplazamos al siguiente registro del recordset.
MoveLast: Nos desplazamos al último registro del recordser.
Move fila [,inicio]: Permite desplazarnos un número específico de registro hacia delante o hacia atrás respecto al marcador de inicio.

El marcador BOF nos indica que estamos al principio del recordset y el marcador EOF nos indica que estamos al final. Si situas el registro actual en dichos marcadores, no se producirá un error pero no podrás acceder a la información del registro actual ya que no es un registro válido.
Si se sobrepasa dichos marcadores se producirá un error en tiempo de ejecución. Hay que utilizar las propiedades BOF y EOF para prevenir este tipo de errores.
La acción indicada por el valor de las propiedades BOFAction y EOFAction del control data se ejecutan cuando el registro actual se sitúa en los marcadores BOF y EOF respectivamente.
Recuerda que BOFAction y EOFAction son propiedades del control data mientras que BOF y EOF son del recordset.


Buscar registros

Para buscar registros puedes utilizar los métodos Find cuando trabajes con recordset de tipo Dynaset o Snapshot, o utilizar el método Seek para un recordset de un tipo Table.
El método Find presenta cuatro variantes:

FindFirst: Busca el primer registro que cumple determinado criterio.
FindLast: Busca el último registro que cumpla un determinado criterio.
FindNext: Realiza la búsqueda hacia delante.
FindPrevious: Realiza la búsqueda hacia atrás.

Veamos un ejemplo:

With.datEmpleados
.Recordset.FindFirst "Nombre = ' " & txt.Nombre.Text & "'"
If Recordset.NoMatch Then
MsgBox "Lo siento no es un nombre de empleado válido"
Exit Sub
End If
End With

Mediante el uso de la estructura With nos evitamos tener que repetir código. Así no será necesario escribir la estructura datEmpleados hasta que lleguemos a End With.
En la línea .Recordset.FindFirst "Nombre = ' " & txt.Nombre.Text & "'" es donde se produce la búsqueda de un determinado registro del recordset.
Al utilizar el método FindFirst se está indicando que se efectúe la búsqueda del primer registro cuyo valor en el campo Nombre coincide con el valor que se ha introducido en el txtNombre.
Con el uso del operador & concatenamos para crear el criterio de búsqueda, si por ejemplo se hubiera introducido el valor Coral en el cuadro de texto, esta línea quedaría de la siguiente forma:

datEmpleados.Recordset.FindFirst "Nombre='busqueda'"

Luego utilizamos el método Nomatch del recordset para comprobar, una vez realizada la búsqueda, si se ha encontrado un registro o no. Si no se ha encontrado el registro, el método nomatch devolverá True por lo que se mostrará un menseja mediante el MsgBox y se saldrá del procedimiento utilizando el método Exit Sub.


Añadir registros

El valor AddNew en la propiedad EOFAction del control data nos permitía agregar registros, pero esta forma sólo es adecuada cuando estamos accediendo a una única tabla en el recordset.
El objeto recordset contiene el método AddNew que permite la creación de un registro nuevo en blanco donde puedes asignar los valores a sus campos.
Una vez introducida dicha información, tendrás que hacer uso del método Update del recordset, con el objetivo de que el nuevo registro se actualice en la tabla. Si no utilizas Update el nuevo registro no se agregará finalmente.
El código será:

datEmpleados.Recordset.Update

La propiedad Bookmark se usa para saltar rápidamente al nuevo registro indicado por el marcador LasrModified. Boolmark te permite guardar el puntero del registro actual y colocarse rápidamente en un registro específico.
El código será:

registroActual = datEmpleados.Recordset.Bookmark Aquí se guarda el registro actual
datEmpleados.Recordset.MoveFirst Desplazamos al registro actual
datEmpleados.Recordset.Bookmark = registroActual Vuelve al marcador guardado


Eliminar registros

Mediante el método Delete, puedes borrar un registro entero de un recordset. En este caso te tienes que situar en el registro y hacer uso de éste método.
Tienes que tener cuidado a la hora de eliminar un registro, ya que el registro actual sigue siendo el registro eliminado, por lo que cualquier intento de acceder a la información del registro actual provocará un error de ejecución.
Para evitar éste problema es conveniente desplazarno a un registro válido una vez hayas utilizado el método. No es necesario el uso de Update para hacer efectiva la eliminación.
Un código de ejemplo sería:

If datEmpleados.Recordset.EOF = False
datEmpleados.Recordset.Delete
If datEmpleados.Recordset.EOF = True Then
cmdEliminar.Enabled = True
End If
datEmpleados.Recordset.MoveLast
End If

En la primera línea se comprueba si el recordset está vacío, es decir, si la propieda EOF tiene su valor a True.
En el caso de que el recordset no esté vacío, se realiza la eliminación del registro actual, más tarde se vuelve a comprobar si el recordset está vacío ya que se podía haber borrado el único registro que contenía.
Finalmente no movemos al último registro con MoveLast, ya que el registro actual no es válido al haber sido eliminado. En el caso de no existir ningún registro válido MoveLast nos situará en el marcador EOF.

[aldo1982]

COMO USAR OPCIONES AVANZADAS DE BASES DE DATOS?

SE HACE DE LA SI. MANERA:

OPCIONES AVANZADAS DE BASES DE DATOS


Cuadricula enlazada a datos

En algunas ocasiones desearás mostrar más de un registro a la vez, con sus correspondientes campos. Para ello Visual Basic incorpora un nuevo control llamado Cuadrícula, que se presenta en dos versiones: enlazada y no enlazada
Las dos permiten mostrar información de forma tabular, es decir, con un conjunto de filas y columnas.
La versión enlazada (DBGrid), es más apropiada cuando deseamos mostrar información proveniente de una determinada base de datos.
Al utilizar dicho control puedes mostrar en cada una de sus columnas un campo y en cada una de las filas un registro del recordset del que haya sido enlazado.
El control Cuadrícula enlazada a datos no aparece en la caja de herramientas estándar ya que es un control personalizado con el siguiente htmlecto:






Deberás agregarlo manualmente a la caja de herramientas, su nombre es Data Bound Grid.
El control cuadrícula enlazada a datos aparece inicialmente con dos filas y dos columnas. Se puede modificar en tiempo de diseño esperar que en tiempo de ejecución, cuando se enlace con un determinado recordset se ajuste al mismo.
El primer conjunto de propiedades interesantes de este control es el que establece su comportamiento en tiempo de ejecución. Las propiedades AllowAddNes, AllowDelete y AllowUpdate nos indican si en tiempo de ejecución se va a permitir añadir, eliminar o actualizar respectivamente el registro de la cuadrícula.
La propiedad que establece el enlace con el correspondiente control data es, al igual que en el resto de controles enlazados DataSource. Sin embargo, no presenta la propiedad DataField ya que cuando utilices una cuadrícula es para mostrar un conjunto de registros, que seguramente tendrán más de un campo.


Consultas en SQL

Cuando quieras mostrar información que provenga de más de una tabla, no tienes más remedio que utilizar el lenguaje SQL para establecer la correspondiente consulta en la propiedad RecordSource de un control data.
SQL es un lenguaje que pretende ser estándar en el acceso a bases de datos relacionales, de forma que independientemente del origen de la información, puedas acceder a ella a través de instrucciones SQL.
Puedes establecer la propiedad RecordSource del control data en tiempo de ejecución y darle el valor de una determinada instrucción SQL, de esta forma el usuario puede especificar lo que quiere extraer de la base de datos.
Una vez establecida la propiedad RecordSource, tienes que utilizar el método Refresh del control data para crear el objeto recordset, al haber cambiado la propiedad del recordsource.
La instrucción que se utiliza para crear consultas de selección SQL es SELECT. La síntaxis de esta instrucción es la siguiente:

SELECT -columnas-
FORM -tablas-
[WHERE -condiciones-]
[ORDER BY -columnas-]

La instrucción SELECT comienza con dicha palabra y un conjunto de columnas, es decir, el conjunto de campos que queremos que muestre la consulta como resultado de la misma.
Seguidamente aparecere la cláusula FORM, que identifica las tablas sobre las que se realiza la consulta. Los campos especificados en la cláusula SELECT deben pertenecer a las tablas especificadas en FORM.
Seguidamente nos encontramos con dos cláusulas opcionales como nos indican la presencia de cochetes. La cláusula WHERE especifica el criterio que debe cumplir para que un determinado registro aparezca en el resultado de la consulta.
Normalmente serán expresiones de comparación del tipo NombreCampo = Valor o usando ciertas funciones de SQL.
La cláusula ORDER BY especifica en qué orden aparecerán los resultados de una consulta. Tienes que especificar el campo o conjunto de campos por los que se ordenan los registros de la consulta. También puedes indicar si el orden es ascendente o descendente.
Vamos a ver un ejemplo:

SELECT Nombre
FORM Empleados

Se especifica que se muestre el campo Nombre de los registros que pertenecen a la tabla Empleados.
Si quieres que se muestra más de un campo, hay que separarlos por comas, y si quieres que se muestren todos los campos de una tabla se puede utilzar el caráter *. Así, la consulta devolverá todos los campos de la tabla Empleados.

SELECT Empleados.Nombre, Empleados.[fecha alta]
FORM Empleados,TiempoAlta
WHERE Empleados.Puesto = TiempoAlta.Puesto

En esta caso se está pidiendo que se muestren los campos Nombre y TiempoAlta de los registros situados en la tabla Empleados y cuyo Puesto exista en algún registro de la tabla Puesto.
Si se utilizan más de una tabla de consultas es conveniente indicar el nombre de la tabla en la cláusula SELECT junto al nombre del campo que quieres mostrar, por que las dos tablas podrían tener el mismo nombre para uno o más campos.
Si el nombre de un campo está compuesto por más de una palabra, tienes que utilizar corchetes para delimitarlo.
Todas las tablas implicadas aparecen en la cláusula FORM separadas por comas.
La cláusula WHERE presenta el criterio de comparación.


Validar el control data

Cuando se intereactua con el control data en un formulario podemos utilizar alguno de sus eventos para establecer niveles de validación de los datos que se han introducido o modificado.
El evento más utilizado es validate. Sucede siempre antes de que el registro actual cambie.
Veamos un ejemplo:

Private Sub datEmpleados_Validate(Action As Integer, Save As Integer)
Dim respuesta As Integer
If Save = True Then
respuesta = MsgBox("Quieres guardar los cambios", vbYesNo)
If respuesta = vbNo Then
Save = False
End If
End If
End Sub

El procedimiento de evento Validate contiene dos parámetros: Action que indica por qué se ha producido el evento y Save que indica se se debe o no modificar la base de datos.
Así el código utiliza el parámetro Save y permite confirmar, por parte del usuario, que se lleve a cabo la modificación que se ha realizado. Se se responde No, los cambios no tienen efecto al establecer el valor False del parámetro Save.
También se pueden crear reglas de validación al crear una tabla. Así puedes introducir reglas de validación junto al menseja que debe aparecer si se infringen, reglas de integridad referencial, etc...

[aldo1982]

COMO TRABAJAR CON ARCHIVOS EN VB??


PARA TRABAJAR CON ARCHIVOS SE HACE LO SIG. :


Controles espacializados

Visual Basic proporciona una serie de controles especializados en el acceso al sistema de archivos de windows.
Estos controles son el Cuadro de lista de unidades, el Cuadro de lista de directorios y el Cuadro de lista de archivos. Cada uno de estos controles permite acceder a los correspondientes elementos del sistema de archivos.






Al cuadro de lista de unidades (figura superior), tienes que darle un tamaño adecuado para que se pueda mostrar cualquier unidad que tengas en tu ordenador. En tiempo de diseño se muestra la etiqueta de la unidad del disco duro de forma que puedas ajustar el control al tamaño de la misma.
Este control incluye las unidades de disco duro, disco flexible y Cd-Rom, etc...





El cuadro de lista de directorios nos permite mostrar los directorios del sistema de archivos del ordenador.
Es conveniente que este control muestre tres o cuatro carpetas o directorios. En tiempo de diseño muestra la carpeta en la que se inicia la apliación y en la que por defecto se guarda el proyecto.





El cuadro de lista de archivos nos muestra los archivos de un determinado directorio o carpeta. Su propiedad más interesante es Pattern que nos permite especificar qué tipo de archivos son mostrados en dicho control. Para utilizar esta propiedad se pueden utilizar los comodines * y ? al establecer la propiedad. Estos caracteres tienen el mismo significado que en MS-Dos o Windows para especificar los nombres de los archivos.
Si estableces la propiedad Pattern con la cadena *.txt, estás indicando que se muestren sólo los archivos que tengan esta extensión. Se pueden mostrar más de un tipo de archivos separándolos con ;.





Conectar controles

En tiempo de diseño, al dibujar los distintos controles del sistema de archivos, estos muestran la unidad y el directorio en la que se crea el proyecto como he comentado anteriormente. En tiempo de ejecución el usuario puede cambiar la unidad y el directorio o carpeta y esta situación no se verá reflejada si no se escribe código.
Para que los controles estén sincronizados es necesario conectarlos.
El evento predeterminado del control cuadro de lista de unidades es Change. Este evento sucede cuando el usuario despliega la lista de unidades y selecciona una unidad distinta a la actual, por lo que es el evento adecuado para actualizar la lista de directorios de la siguiente forma:

Private Sub Dir1_Change()
Dir1.Parh = Drive1.Drive
End Sub

Para el control cuadro de lista de directorios deberemos hacer algo parecido, el código será el siguiente:

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

De esta forma tenemos conectados los tres controles de acceso al sistema de archivos.


Manejando los errores

Cuando se escribe código en tiempo de diseño, Visual Basic puede detectar errores y avisar de ellos. Posteriormente se pueden detectar más errores en tiempo de compilación, estos errores son de carácter semántico. Los errores en tiempo de ejecución son sucesos inesperados que Visual Basic no puede controlar por sí mismo.
Ante este tipo de errores existe la posibilidad de incorporar un manejador o controlador de errores, que son un conjunto de líneas de código que sólo se ejecutan cuando se produce un error que es interceptado por Visual Basic.
Se deben de escribir manejadores de errores siempre que se pueda preveer la ocurrencia de un error en tiempo de ejecución. Alguna de estas situaciones son:
- Problemas con las unidades de disco flexible.
- Desbordamientos.
- Falta de memoria.
- Problemas con la red.
- Periféricos.
- Errores lógicos (nombre de archivo mal escrito...)
La instrucción que nos permite detectar errores en tiempo de ejecución es On Error. Su síntaxis es: On Error Goto Etiqueta, donde la etiqueta representa el nombre del manejador de error, que tiene que estar situado en el mismo procedimiento que la instrucción On Error. Cuando se produce un error en el procedimiento donde se coloca On Error, Visual Basic dará el control al manejador de errores escrito en dicho procedimiento.
El código puede ser:

ManejadorError:
If Err.Number = 68 Then
resp = MsgBox("El dispositivo no está preperado", vbAbortRetryIgnore)
Resume
ElseIf resp = vbAbort Then
Drive1.Drive = Dir1.Ptah
Resume Next
End If
End If

La primera línea es la etiqueta que represena el nombre del manejador.
Al producirse un error en tiempo de ejecución se crea un objeto Err que intercepta dicho error. Este objeto posee la propiedad Number que es el número de error interceptado.
El código pregunta si dicho error es el 68 y en ese caso presenta un cuadro de diálogo en el que se indica que el dispositivo no está preparado, dando tres opciones: reintenter, cancelar o ignorar.
Una vez interceptado el error y ejecutado el código asociado al manejador, es necesario indicar qué sucede una vez se salga del manejador. En este caso dependerá de lo que elija el usuario. Si quiere reintentar la operación se ejecutará la instrucción Resume, que vuelve a ejecutar la misma intrucción que provocó el error.
Si se anula la operación se ejecutará Resume Next, que devuelve el control a la siguiente instrucción que provocó el error.

[aldo1982]

TRABAJAR CON ARCHIVOS II


Archivos de texto

Vamos a escribir código para cuando el usuario haga click en un archivo de la lista de archivos (capítulo 15), su contenido se muestre en un cuadro de texto.
El código puede ser el siguiente:

Private Sub File1_Click()
Dim nuevalinea As String, LTexto As String, Texto As String, Archivo As String
nuevalinea = Chr$(13) + Chr$(10)
Archivo = File1.Path & "\" & File1.filename
Open Archivo for Input As #1
Do Until EOF(1)
Line Input #1, LTexto
Texto = Texto & LTexto & nuevalinea
Loop
Text1.Text = Texto
Close #1
End Sub

Cuando el usuario selecciona un determinado archivo de la lista, su nombre se especifica en la propiedad filename del cuadro de lista de archivos. Tienes que indicar la ruta de acceso completa, por lo cual se concatena el directorio, que se encuentra en la propiedad Path y el caráter \ como separador de directorios.
Una vez tenemos en la variable Archivo el nombre y ruta completa del archivo que deseamos mostrar, es necesario abrir dicho archivo. Para ello utilizamos la instrucción Open.
La instrucción Open necesita el nombre del archivo que tiene que abrir y el modo en que se va a abrir.
En la línea Open Archivo for Input As #1, el archivo a abrir está situado en la variable Archivo, en modo de lectura, especificado mediante la instrucción Input y su número asociado que es el #1.
Una vez tenemos abirto el archivo en modo lectura, utilizamos la variable LTexto para ir almacenando cada una de la líneas del archivo de texto. Para ello utilizamos la instrucción Line Input donde se indica el número del archivo y la variable en al que se guarda la línea de texto.
Esta instrucción se situa en un bucle Do Until...Loop repitiéndose hasta que se llega al final del archivo de texto especificado por la condición EOF(1).
En la línea Text1.Text = Texto, es donde se asocia el contenido del archivo con el cuadro de texto del formulario a través de su propiedad Text.
Finalmente se cierra el archivo mediante la instrucción Close #1.






La instruccion FileCopy

La instrucción FileCopy nos permite realizar una copia de un determinado archivo.
La síntaxis de esta instrucción es:

FileCopy fuente, destino

La fuente es el archivo que queremos copiar y el destino es el archivo que será resultado de la copia.
El archivo fuente tiene que estar cerrado antes de utilizar esta instrucción ya que en caso contrario se producirá un error en tiempo de ejecución. Con la instrucción FileCopy puedes copiar cualquier archivo independientemente de su tipo.

[aldo1982]

COMO USAR OLE??

ACA UN BREVE INTRODUCCIÓN PARA LUEGO EXPLICAR:

Introduccion

Compartir información sobre distintas aplicaciones es una de las características más potentes que posee Windows. Al compartir información, lo que realmente se está haciendo es compartir objetos que son creados por dos o más aplicaciones Windows distintas. Aquí es donde entra en juego OLE, sentando las bases para crear y compartir objetos entre distintas aplicaciones.
Visual Basic actúa como nexo entre las aplicaciones Windows al permitir el uso de objetos OLE en sus aplicaciones. Se pueden tener en un mismo formulario de Visual Basic una hoja de cálculo de Excel y un documento de Word.
Visual Basic puede utilizar los objetos de otras aplicaciones de la misma forma que cualquier otro objeto de Visual Basic. Puede establecer o leer propiedades, utilizar sus métodos, etc... Esto se denomina Automatización OLE.


El contenedor OLE

Mediante el uso del control contenedor OLE, puedes crear formularios de Visual Basic en los que se incluya información proveniente de distintas aplicaciones Windows.






Estos formularios son conocidos como documentos compuestos, en los que la funcionalidad que se necesita no la proporciona la aplicación creada por Visual Basic, sino que se aprovecha de las aplicaciones que crean los objetos insertados.
Así, el equipo donde se ejecute la aplicación Windows como hoja de cálculo Excel o procesador de textos como Word no necesitarán programar para conseguir que la aplicación presente la funcionalidad de dichas aplicaciones, sino que puedes utilizarlas desde tu aplicación.
Al pulsar el control OLE en la caja de herramientas de Visual Basic nos aparecerá el siguiente cuadro de diálogo:





En este cuadro nos aparecen los distintos tipos de objetos que podemos insertar en el formulario. Estos objetos provienen de las aplicaciones compatibles con OLE que tengas instaladas en tu equipo.
Cuando una aplicación se instala en un ordenador queda registrada en el Registro de Windows. Este registro es como una base de datos don Windows guarda información referente a las aplicaciones que tiene instaladas. Entre otras cosas se guardan los objetos insertables que ofrecen dichas aplicaciones y que después nos aparecerán en el cuadro de diálogo insertar objeto.
Se puede insertar en un formulario un objeto utilizando la opción Cerrar Nuevo o utilizar uno ya existente mediante la opción cerrar desde archivo. En este último caso tienes que especificar el archivo que posee el objeto a insertar.
Si quieres que el objeto insertado aparezca en el formulario como un icono, puedes activar la casilla mostrar como icono del cuadro de diálogo insertar objeto.
Puedes indicar que el objeto sea incrustado o vinculado. Al incrustar un objeto se crea una copia y se guarda en la aplicación Visual Basic, por lo que sólo se podrá usar en esta.
Al vincular un objeto, éste sigue estando almacenado en el archivo original, guardándose en la aplicación una referencia al mismo y no el objeto en sí.


Edicion del objeto

Cuando insertas un objeto a través del control contenedor OLE, estás en disposición de editar el objeto con la aplicación creadora del mismo. Para ello lo único que tienes que hacer es doble click sobre el objeto.
Al activar el objeto haciendo doble click, la aplicación servidora es iniciada y el usuario puede interactuar con ella utilizando toda la funcionalidad que presente.
En este sentido es importante indicar aplicaciones que permitan que la edición sea en el propia control contenedor (Edición Visual), y otras en la que la edición se produce en una ventana independiente.
Para que la edición del objeto sea en el propio contenedor OLE, es necesario haber incrustado el objeto, ya que toda vinculación producirá que la aplicación servidora se muestre en una ventana independiente. Por otra parte, si el objeto se representa como un icono en el formulario, también se presentará en una ventana independiente la aplicación servidora.
Cuando la aplicación servidora se muestra en una ventana independiente, no existen problemas para presentar los menús y barras de herramientas de la misma.
Pero si el formulario donde has insertado un objeto posee menús o barras de herramientas y la edición del objeto se produce en el propio contenedor, tienes que negociar dichos elementos, es decir, tienes que indicar como se han de mostrar.
Si quieres que los menús de la aplicación servidora se muestren al editar el objeto, es necesario que el formulario donde está insertado el objeto posea un elemento de menú, aunque esté no visible. Además en el editor de menús puedes especificar en qué posición deben de mostrarse cuando se edite el objeto en el contenedor OLE.
La propiedad NegociatePosition que aparece en el editor de menús, establece la posición de los elementos del menú de nuestro formulario.
Puede tener los siguientes valores:
- 0: Indica que dicho elemento del menú se verá cuando se edite el objeto, mostrándose únicamente el menú de la aplicación servidora.
- 1, 2 y 3: Establece donde se mostrará, pudiendo ser a la izquierda, centro o derecha.

Independientemente de la propiedad NegocitaPosition del menú, es necesario establecer la propiedad NegociateMenu del formulario a True. En otro caso, la negociación de menús no se llevará a cabo.
Toda vinculación o uso de la opción Mostrar como Icono implicarán que el objeto se edite en una ventana independiente.


Objetos insertables

Algunas aplicaciones proporcionan objetos que pueden utilzarse como controles personalizados en Visual Basic.
De esta forma se pueden agregar a la caja de herramientas de Visual Basic sin tener que utilizar el control contenerdor OLE.
Para esto utilizaremos el el menú contextual de la caja de herramientas o elegir Controles personalizados en el menú de herramientas.






Activa las casillas de los objetos que utilzas normalmente en tus aplicaciones y ya no será necesario utilizar el control contenedor OLE, insertando el objeto específico de una forma directa a través de los botones de la caja de herramientas que aparecen para ello.
Además es posible que una aplicación aporte más de un tipo de objeto insertable. Por ejemplo, Excel permite la inserción de objetos hoja de cálculo y gráficos.
Tienes que tener en cuenta que al utilizar un objeto insertable como control personalizado en la caja de herramientas, sólo puedes incrustar un objeto nuevo ya que no tienes la opción de utilizar un archivo existente, pero si puedes editarlo en tiempo de ejecución, aplicando las mismas reglas que en el caso del control contenedor OLE.


Automatizacion OLE

Una de las características más potentes de la utilización del estádar OLE es la Automatización OLE.
Nos permite mediante programación, integrar varias aplicaciones Windows en una aplicación creada con Visual Basic.
El estándar OLE permite que las aplicaciones actúen como servidores OLE o como clientes OLE. Un servidor OLE proporciona objetos que pueden ser utilizados en otras aplicaciones. Un cliente OLE es una aplicación que utiliza objetos creados en una aplicación distinta.
Al utilizar la automatización OLE, puedes utilizar los objetos de otras aplicaciones como si fueran objetos de Visual Basic, estableciendo propiedades y utilizando sus métodos.
El uso del examidor de objetos permite conocer y pedir ayuda sobre los componentes de dichos objetos, facilitando la utilización de sus métodos y propiedades de la forma correcta:

Dim x As Object
Set x = CreateObject ("Word.Basic")
x.ArchivoNuevo
x.TamañoFuente 24
x.Insertar "Uso de la Automatización OLE"

En el ejemplo anterior se puede observar un fragmento de código donde se crea un objeto Word, se utiliza un método para crear un nuevo archivo, se establece la propiedad tamaño de fuente a 24 puntos y se inserta texto en el punto de inserción.