1:
In a Module:
Code:
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Refrence: Here
2:
If In sheet1 from Range("A1")
Paste below Data:
FileName Address Status
abc.xlsm C:\XYZ
pqr.xls C:\XYZ
On form:
Code:
Private Sub cmdSubmit_Click()
Dim lngCounter As Long
Dim strAddress As String
For lngCounter = 0 To lstFileAddress.ListCount - 1
strAddress = lstFileAddress.List(lngCounter, 1) & "\" & lstFileAddress.List(lngCounter, 0)
If lstFileAddress.Selected(lngCounter) Then
If Not IsFileOpen(strAddress) Then
Range("TempRange").Find(lstFileAddress.List(lngCounter, 0)).Offset(, 2).Value = "Close"
Else
Range("TempRange").Find(lstFileAddress.List(lngCounter, 0)).Offset(, 2).Value = "Open"
End If
End If
Next
Unload Me
End Sub
Code:
Private Sub UserForm_Initialize()
Range("A1").CurrentRegion.Offset(1).Resize(Range("A1").CurrentRegion.Rows.Count - 1, Range("A1").CurrentRegion.Columns.Count - 1).Name = "TempRange"
With lstFileAddress
.ColumnHeads = True
.ColumnCount = 2
.RowSource = "TempRange"
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
End With
End Sub
Bookmarks