Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA create log file

Tags:

excel

vba

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
like image 662
Fiínek Cahů Avatar asked Aug 15 '26 10:08

Fiínek Cahů


1 Answers

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.

like image 57
Vincent G Avatar answered Aug 18 '26 02:08

Vincent G



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!