Crea directorio
===============
 
Sub CreaDirectorio(NombreDirectorio As String)
Dim sTemp As String
Dim Posicion As Integer
Dim PosicionAnt As Integer
On Error GoTo ErrorCreaDirectorio

sTemp = ""
PosicionAnt = 1
Posicion = InStr(PosicionAnt, NombreDirectorio, "\")
If Posicion <> 0 Then
    PosicionAnt = Posicion
    Posicion = InStr(PosicionAnt + 1, NombreDirectorio, "\")
End If

Do While Posicion <> 0
    sTemp = Mid(NombreDirectorio, 1, Posicion - 1)

    If Dir(sTemp, vbDirectory) = "" Then
        MkDir sTemp
    End If
    PosicionAnt = Posicion
    Posicion = InStr(PosicionAnt + 1, NombreDirectorio, "\")
Loop

sTemp = Mid(NombreDirectorio, 1, Len(NombreDirectorio))
If Dir(sTemp, vbDirectory) = "" Then
    MkDir sTemp
End If

Exit Sub
ErrorCreaDirectorio:
    MuestraError   "CreaDirectorio", Err, Error
End Sub

 
Copia Fichero
=============

 
Function CopiaFichero(NombreDirectorio As String, NombreFicheroListados As String) As Boolean
'Funcion que crea un directorio de no existir este y 'copia en el mismo un fichero que esta en el directorio de nuestra aplicación.
Dim sTemp As String
Dim PorimeraPosicion As Integer
Dim Posicion As Integer
Dim PosicionAnt As Integer
On Error GoTo ErrorCopiaFichero

CopiaFichero = False
'Si no existe el directorio lo creamos
If Dir(NombreDirectorio, vbDirectory) = "" Then
    CreaDirectorio (NombreDirectorio)
End If
'Vemos si existe el fichero en el directorio
If Dir(NombreDirectorio & "\" & NombreFicheroListados) = "" Then
    'Copiamos el fichero si no existe. Vemos si existe el fichero en el directorio de nuestra aplicación
    If Dir(App.Path & "\" & NombreFicheroListados) <> "" Then
        'Copiamos el fichero de listados del directorio de la aplicacion al directorio seleccionado.
        FileCopy App.Path & "\" & NombreFicheroListados, NombreDirectorio & "\" & NombreFicheroListados
    Else
        MsgBox "No se ha podido encontrar el fichero " & App.Path & "\" & NombreFicheroListados, vbExclamation, "Atención"
        Exit Function
    End If
End If
CopiaFichero = True
Exit Function
ErrorCopiaFichero:
    MuestraError "CopiaFichero", Err, Error
End Function
 
Lee Fichero INI
===============

 
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Function LeeINI(Clave As String, SubClave As String, FileName As String) As String
'Funcion para capturar datos de un fichero .INI
Dim Res As Long
Dim Datos As String

On Error GoTo ErrorLeeINI

Datos = Space(255)
Res = GetPrivateProfileString(Clave, SubClave, "", Datos, Len(Datos), FileName)
LeeINI = Trim(Mid(Datos, 1, Res))
Exit Function
ErrorLeeINI:
ShowError "", "LeeINI", Err, Error

End Function

 
Escribir Fichero INI
==================== 
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Function EscribeINI(Clave As String, SubClave As String, Valor As String, FileName As String) As Boolean
'Funcion para escribir datos de un fichero .INI
Dim Res As Long

On Error GoTo ErrorEscribeINI

EscribeINI = False
Res = WritePrivateProfileString(Clave, SubClave, Valor, FileName)
EscribeINI = True
Exit Function
ErrorEscribeINI:
ShowError "", "EscribeINI", Err, Error

End Function