VBA Access. Módulo de clase clsLog. Escribir en un fichero. Útil para crear ficheros tipo Log o escribir cualquier valor a un fichero.

Option Compare Database
Option Explicit

Private Sub Class_Initialize()
    'initialize values
End Sub

Private Sub Class_Terminate()
    'deallocate if needed
End Sub

Public Function Log(ByVal sPathFileName As String, ByVal sValueToLog As String, Optional ByVal bAppend As Boolean = True) As String
On Error GoTo error
    Dim sValue As String    'valor a escribir en el log
    Dim SFName As String    'ruta y nombre completo del fichero de texto
    Dim iFNumber As Integer

    sValue = sValueToLog
    SFName = sPathFileName

    'crear la ruta completa si no existe
    MakeDirFullPath (Left(SFName, InStrRev(SFName, "\") - 1))

    'obtener numero de fichero
    iFNumber = FreeFile

    'añadir o sobreescribir el fichero
    If bAppend Then
        Open SFName For Append As #iFNumber
    Else
        Open SFName For Output As #iFNumber
    End If

    Print #iFNumber, sValue
    Close #iFNumber

    Log = SFName

Exit Function
error:
    Log = ""
    Debug.Print Err.Description
End Function

Private Function MakeDirFullPath(ByVal sPath As String) As Boolean
On Error GoTo error
    'crear todo el path de un directorio
    If Right(sPath, 1) = "\" Then
        sPath = Left(sPath, Len(sPath) - 1)
    End If
    Dim SplitPath() As String
    SplitPath = Split(sPath, "\")
    Dim Value As Integer
    Dim Merge As String
    For Value = 0 To UBound(SplitPath)
        If Value <> 0 Then
            Merge = Merge & "\"
        End If
        Merge = Merge & SplitPath(Value)
        If Dir(Merge, vbDirectory) = "" Then
            MkDir Merge
        End If
    Next
    SetAttr sPath, vbNormal
    MakeDirFullPath = True
   
Exit Function
error:
    MakeDirFullPath = False
    Debug.Print Err.Description
End Function