Hi

Put this code in Userform module.

Dim wbkActive As Workbook
Private Sub CommandButton1_Click()

    Dim FilePath    As String
    Dim FileName    As String
    Dim wbkOpen     As Workbook
    Dim LastRow     As Long

    If wbkActive Is Nothing Then Set wbkActive = ThisWorkbook

    FilePath = wbkActive.Worksheets(1).[i1]
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    If Len(Me.TextBox1.Value) Then
        If Len(Me.TextBox2.Value) Then
            If Len(Me.TextBox3.Value) Then
                FileName = FilePath & Me.TextBox3.Value & ".xlsx"
                If Not FileIsOpen(FileName) Then
                    Set wbkOpen = Workbooks.Open(FilePath &
Me.TextBox3.Value & ".xlsx")
                    With wbkOpen.Worksheets(1)
                        LastRow = .Range("b" & .Rows.Count).End(3).Row + 1
                        .Range("a" & LastRow) = LastRow - 3
                        .Range("b" & LastRow).Resize(, 3) =
Split(Me.TextBox2.Value & "," & Me.TextBox1.Value & "," &
Me.TextBox3.Value, ",")
                    End With
                    wbkOpen.Close 1
                    Set wbkOpen = Nothing
                    MsgBox "Done", , "ExcelFox.com"
                    Unload Me
                Else
                    MsgBox "Workbook '" & FileName & "' is already
opened." & vbLf & "Close the workbook and try again", vbInformation,
"ExcelFox.com"
                    Exit Sub
                End If
            Else
                MsgBox "Emp ID is missing", vbInformation, "ExcelFox.com"
                Me.TextBox3.SetFocus
            End If
        Else
            MsgBox "Batch No is missing", vbInformation, "ExcelFox.com"
            Me.TextBox2.SetFocus
        End If
    Else
        MsgBox "Site is missing", vbInformation, "ExcelFox.com"
        Me.TextBox1.SetFocus
    End If
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Function FileIsOpen(ByVal FileName As String) As Boolean

    Dim ff  As Long

    On Error GoTo Xit
    ff = FreeFile()
    Open FileName For Random Access Read Write Lock Read Write As ff
    Close ff
    FileIsOpen = False
    Exit Function
Xit:
    Close ff
    FileIsOpen = True
End Function


In I1 enter the network path.


Kris
ExcelFox

-- 
Join official facebook page of this forum @ 
https://www.facebook.com/discussexcel

FORUM RULES (1120+ members already BANNED for violation)

1) Use concise, accurate thread titles. Poor thread titles, like Please Help, 
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get 
quick attention or may not be answered.

2) Don't post a question in the thread of another member.

3) Don't post questions regarding breaking or bypassing any security measure.

4) Acknowledge the responses you receive, good or bad.

5)  Cross-promotion of, or links to, forums competitive to this forum in 
signatures are prohibited. 

6) Jobs posting is not allowed.

7) Sharing copyrighted ebooks/pirated ebooks/their links is not allowed.

NOTE  : Don't ever post personal or confidential data in a workbook. Forum 
owners and members are not responsible for any loss.
--- 
You received this message because you are subscribed to the Google Groups "MS 
EXCEL AND VBA MACROS" group.
To post to this group, send email to excel-macros@googlegroups.com.
To unsubscribe from this group, send email to 
excel-macros+unsubscr...@googlegroups.com.


Reply via email to