Bueno esta es mi primera colaboración, es una pequeña función que les ayudara a no colocar el path de un archivo o una base de datos de forma explicita en el código ej: BASE.ConectionString = "c:\mi_archivo\archivo.txt" o bien lo mas común entre programadores BASE.ConectionString = App.Path & "\mi_archivo.txt" , ya que si necesitamos compartir este archivo que es muy común que lo hagamos como lo es el caso de una base de datos de Microsoft Access, la ruta del server puede variar, en fin aquí les va el código espero les ayude.

Nota: Para que el código les funcione deben utilizar las librerías de Microsoft Scripting Runtime.

A continuación muestro el código del modulo escrito en Visual Basic:

Public StrRutaDeArchivo As String 'Esta sera la variable que contendra la ruta del archivo

Sub MensajeError()
	  'Rutina que captura los errores y los imprime.
   MsgBox Err.Description, vbCritical, "FrankSoft"
   Err = 0
End Sub

Function EscribirArchivo(StrRuta As String) As Boolean
On Local Error GoTo eEscribirArchivo
	  'Rutina que permite actualizar la ruta que contiene el archivo.
	  Dim FSO As FileSystemObject
   Dim TS As TextStream
   
   Set FSO = New FileSystemObject
   Set TS = FSO.OpenTextFile(App.Path & "\config.fst", ForReading)
   
   If Len(Trim(StrRuta)) = 0 Then
   	'Pudo llegar una cadena vacia por lo tanto indica
	    'que no se escribio el archivo.
   	EscribirArchivo = False
   	GoTo Salida
   Else
   	'Hay una ruta se guarda en el archivo
     Set TS = FSO.OpenTextFile(App.Path & "\config.fst", ForWriting)
   	TS.WriteLine StrRuta
   	StrRutaDeArchivo = StrRuta
   	EscribirArchivo = True
   	GoTo Salida
   End If
Salida:
   TS.Close
   Set FSO = Nothing
   Set TS = Nothing
   Exit Function
eEscribirArchivo:
   EscribirArchivo = False
   MensajeError
   GoTo Salida
End Function

Function LeerArchivo() As Boolean
On Local Error GoTo eLeerArchivo
	  'Rutina que nos permite saber si la ruta dek archivo es valida.
	  'y en caso que no exista el archivo que contendra la ruta lo crea.
   Dim FSO As FileSystemObject
   Dim TS As TextStream
   Dim StrTemp As String
   
   Set FSO = New FileSystemObject
   
   If FSO.FileExists(App.Path & "\config.fst") Then
   	 'El archivo existe y se lee la informacion que contenga.
      Set TS = FSO.OpenTextFile(App.Path & "\config.fst")
      If TS.AtEndOfStream Then
         LeerArchivo = False
         GoTo Salida
      End If
   	 StrTemp = TS.ReadLine
   	 If StrTemp = "[Nothing]" Then
   	 	LeerArchivo = False
   	 	GoTo Salida
   	 ElseIf FSO.FileExists(StrTemp) Then
   	 	'Existe una ruta en el archivo y hay que verificar
   	 	'que el archivo contenido en la ruta exista
   	 	LeerArchivo = True
   	 	'Asigno la ruta del archivo
   	 	StrRutaDeArchivo = Trim(StrTemp)
   	 	GoTo Salida
   	 Else
   	 	'El archivo que contiene la ruta no existe
   	 	LeerArchivo = False
   	 	GoTo Salida
   	 End If
   Else
   	 'El archivo que contiene la ruta no existe y hay que crearlo
   	 'por lo tanto devuelve falso a la hora de leer el archivo
		 'ya que no contiene una ruta valida.
   	 LeerArchivo = False
   	 'Creo el archivo que va a contiener la ruta
   	 'y asigno Nothing para indicar que la ruta esta vacia.
   	 FSO.CreateTextFile (App.Path & "\config.fst")
   	 Set TS = FSO.OpenTextFile(App.Path & "\config.fst", ForWriting)
   	 TS.WriteLine "[Nothing]"
   	 GoTo Salida
   End If
Salida:
   Set FSO = Nothing
   Set TS = Nothing
   Exit Function
eLeerArchivo:
   MensajeError
   GoTo Salida
End Function
 

Bueno hasta aquí el código del módulo a continuación el código del formulario

Function BuscarArchivo() As String
On Local Error GoTo eBuscarArchivo
	   'Configuramos el CommonDialog
    With CDBuscar
        .DialogTitle = "FrankSoft - Buscar Archivo"
        .CancelError = False
        'Filtrarlo segun la necesidad que se tenga
        .Filter = "Bases de datos Access MDB |*.mdb|"
        .ShowOpen
        BuscarArchivo = Trim(.FileName)
    End With
Salida:
      Exit Function
eBuscarArchivo:
      BuscarArchivo = ""
      MensajeError
End Function

Private Sub CmdBuscar_Click()
On Local Error GoTo eCmdBuscar_Click
    If Module1.EscribirArchivo(Trim(.FileName)) Then
    	  LblInfo = "Archivo existe"
       LblRuta = Module1.StrRutaDeArchivo
    End If
Salida:
    Exit Sub
eCmdBuscar_Click:
    MensajeError
End Sub

Private Sub Form_Load()
	  Dim StrMsg As String
   If Module1.LeerArchivo Then
   	 LblInfo = "Archivo: " & Module1.StrRutaDeArchivo
   Else
   	 LblInfo = "Archivo: [Nothing]"
      StrMsg = "Señor Usuario:" & Chr(13) & Chr(13)
      StrMsg = StrMsg & "El archivo que inicia el programa no se encuentra en la ruta especificada." & Chr(13)      
      StrMsg = StrMsg & "Desea buscar el archivo en estos momentos..?"
      If MsgBox(StrMsg, vbYesNo + vbQuestion, "FrankSoft") = vbYes Then
          CmdBuscar_Click
      End If
   End If
End Sub
 

Bueno y esto es todo....!

Si no entienden algo pueden escribirme al mail [email protected]

Hasta pronto...!!!

Fichero con el código de ejemplo: frank_rutaDinamica.zip - 4 KB