0

Within Computer-A there is a shared folder

  1. Main folder ---> csv folder ---> tmp folder
  2. Inside Main folder : wb-A.xlsm and wb-B.xlsm
  3. Inside csv folder : transaction.csv, customer.csv, supplier.csv and item.csv
  4. Inside tmp folder : nothing

User-A in computer-A always use/open wb-A.xlsm to input data, either if there is a new transaction, new cust/sup, or new item where each will be put in the csv file respectively.

User-B in computer-B (connected to the network) always use/open the wb-B.xlsm (which in that shared folder) and move the data (if any) in those csv files to the tables within wb-B.xlsm. Each table is a named range : transaction, customer, supplier, and item.

The code for writing to the csv files (done by user-A, wb-A.xlsm, computer-A) , I use open the csv for append as #1. The code for getting the data from the csv file (done by user-B, wb-B.xlsm, computer-B), I use QueryTables.Add(Connection:="TEXT;" ....).

Because I'm worried there will be a conflict when user-A is writing data to the csv file and user-B is moving data from the same csv file at the same time, what I've tried so far is writing a same code in both wb to check if the tmpFolder is empty. If it's empty, then create a dummy file inside the tmpFolder, do things to the csv file then delete the dummy file. If it's not empty, it will do a checking-loop until the tmpFolder empty is true. If the checking loop is more than 10 seconds, then it exit the sub, meaning the writing/moving data to/from the csv file failed.

So the dummy file in the tmp folder is just for a sign something like "someone is using the files in the csv folder, don't do anything to the files in the csv folder".

The code for a new customer/supplier/item in wb-A.xlsm (simplified) :

Sub WriteToCsv()

csvData = "Mr. John Smith": x = "supplier"
p = ActiveWorkbook.Path & "\csv\"
pTmp = p & "tmp\": pfTmp = pTmp & "Z.txt"

'if pTmp empty create Z.txt file,
'if pTmp not empty loop until pTmp empty
oStart = Timer
Do
    If Dir(pTmp) = "" Then
        Open pfTmp For Output As #1: Close #1
        cek = "True"
    Else
        cek = "False"
        If Timer - oStart > 10 Then _
            MsgBox "Writing to csv file failed": Exit Sub
    End If
Loop Until cek = "True"

'do things to the csv file
    'If cek = "True" Then
        CSVFile = p & x & ".csv"
        Open CSVFile For Append As #1
        Print #1, csvData: Close #1
        Kill pfTmp 'delete the dummy file in tmp folder
    'End If
   
End Sub

The code in wb-B.xlsm :

Sub AddNewDataIfAny()
p = ThisWorkbook.Path & "\csv"
pTmp = p & "\tmp\": pfTmp = pTmp & "Z.txt"

'if pTmp empty create Z.txt file,
'if pTmp not empty loop until pTmp empty
oStart = Timer
Do
    If Dir(pTmp) = "" Then
        Open pfTmp For Output As #1: Close #1
        cek = "True"
    Else
        cek = "False"
        If Timer - oStart > 10 Then _
            MsgBox "Getting data from csv file to this wb failed": Exit Sub
    End If
Loop Until cek = "True"

'do things to the csv file
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(p)
    For Each oFile In oFolder.Files
        pf = p + "\" + oFile.Name
            If FileLen(pf) <> 0 Then
                fn = Split(oFile.Name, ".")(0)
                If fn = "Data" Then _
                      Set ws = Sheets("DATA") Else Set ws = Sheets("TABEL")
                Set rg = ws.Range(fn)
                Set rg = rg.Resize(1, 1).Offset(rg.Rows.Count, 0)
                    With ws.QueryTables.Add(Connection:="TEXT;" & pf, _
                                    Destination:=ws.Range(rg.Address))
                        .TextFileParseType = xlDelimited
                        .TextFileCommaDelimiter = True
                        .Refresh
                        .Delete
                    End With
                Open pf For Output As #1: Close #1 'emptying the csv file
            End If
    Next oFile
Kill pfTmp 'emptying the tmpFolder

End Sub

Although it seems the code work OK, but I'm not so sure if the code will be error-free all the time. So my question : is there a better way to write the code in this kind of situation ?

Any kind of help would be much appreciated.
Thank you in advanced.

karma
  • 1,999
  • 1
  • 10
  • 14

1 Answers1

1

One way for synchronization is to make use of a Mutex object. There is a Mutex object sample in VBA here

As far as I know, Mutex guaranties access to only one thread at a time in AddNewDataIfAny(). So:

    Private Const ERROR_ALREADY_EXISTS = 183&
Private Const MUTEX_ALL_ACCESS = &H1F0001

Private Declare PtrSafe Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare PtrSafe Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long

Private Sub Workbook_Open()
    myMutex = CreateMutex(0, 1, "myMutex")
    Dim er As Long: er = Err.LastDllError
    If er = 0 Then
        MsgBox "myMutex Created"
    ElseIf er = ERROR_ALREADY_EXISTS Then
        MsgBox "mutex previously created"
        myMutex = OpenMutex(MUTEX_ALL_ACCESS, 0, "myMutex")
    Else
        MsgBox "mutex creation failed"
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    CloseHandle myMutex
End Sub

Private Sub doSomeCriticalTask()
    WaitForSingleObject myMutex, 20000 ' say we can wait for 20 seconds
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' do critical section code, access shared data safely
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    AddNewDataIfAny()
    ReleaseMutex myMutex
End Sub
Xavier Junqué
  • 350
  • 2
  • 5
  • I will Google Search to learn more about Mutex object. Thank you for the answer, Xavier. – karma Feb 09 '22 at 01:20