CODEWITHSUNDEEP
vbaexcel
Fiínek Cahů
Fiínek Cahů

Reputation: 67

VBA create log file

Hello can you help me please with code in VBA ? I would like create a log file from text in cells ("C2" and "C3 " + date and time ) when I press button "zadat" Thank you

My code for implementation is:

Module 1

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub zadat()

Dim reg, check As String
Dim i, j, done As Integer
reg = Cells(2, 3).Value
check = Cells(4, 3).Value

If check = "True" Then

    i = 2
    j = 1
    done = 0
    Do While Sheets("data").Cells(i, j) <> ""
        If Sheets("data").Cells(i, j) = reg Then
            vytisteno = ZkontrolovatAVytiskoutSoubor()

            done = Sheets("data").Cells(i, j + 3)
            done = done + 1
            Sheets("data").Cells(i, j + 3) = done
            Exit Do
        End If
        i = i + 1

    Loop
Else
    MsgBox ("Opravit, špatný štítek!!!")
End If

Cells(3, 3) = ""

Cells(3, 3).Select
ActiveWindow.ScrollRow = Cells(1, 1).row


End Sub

Module 2:

Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Function PrintThisDoc(formname As Long, FileName As String)
On Error Resume Next
Dim x As Long
x = ShellExecute(formname, "Print", FileName, 0&, 0&, 3)
End Function

Public Function ZkontrolovatAVytiskoutSoubor() As Boolean
Dim printThis
Dim strDir As String
Dim strFile As String
strDir = "W:\Etikety\Štítky\Krabice\Testy"
strFile = Range("C2").Value & ".lbe"
If Not FileExists(strDir & "\" & strFile) Then
    MsgBox "soubor neexistuje!"
ZkontrolovatAVytiskoutSoubor = False
Else
printThis = PrintThisDoc(0, strDir & "\" & strFile)
ZkontrolovatAVytiskoutSoubor = True
End If
End Function

Private Function FileExists(fname) As Boolean
    'Returns TRUE if the file exists
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True _
       Else FileExists = False
End Function

Upvotes: 3

Views: 16855

Answers (2)

Vincent G
Vincent G

Reputation: 3188

If you don't want to use FSO, there is a simple solution using only VBA statements: Open, Print # and Close: 

Sub Log2File(Filename As String, Cell1, Cell2)
    Dim f As Integer
    f = FreeFile
    Open Filename For Append Access Write Lock Write As #f
    Print #f, Now, Cell1, Cell2
    Close #f
End Sub

I've put the filename and the cells refs as arguments of the sub for re-usability purpose. I also use default (local) formatting, but this can be easily changed. Note that you don't have to check for existence of the file, it will be created if it doesn't exist.

Upvotes: 6

Siva
Siva

Reputation: 1149

Try this. Below code will create a new log file every time

Public Function LogDetails()
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim logFile As Object
  Dim logFilePath As String
  Dim logFileName As String

  'Replace 'TestLog' with your desired file name
  logFileName = "TestLog" & ".txt"
  myFilePath = "C:\Users\..\Desktop\" & logFileName 'Modify the path here

  If fso.FileExists(myFilePath) Then
    Set logFile = fso.OpenTextFile(myFilePath, 8)
  Else
    ' create the file instead
    Set logFile = fso.CreateTextFile(myFilePath, True)
  End If

  logFile.WriteLine "[" & Date & " " & Time & "] " & Worksheet("yoursheetnamehere").Cells(2, 3) & " " &  Worksheet("yoursheetnamehere").Cells(3, 3)

  logFile.Close ' close the file
End Function

Upvotes: 5

Related Questions