11-05-13, 04:36 PM
VB_Coder كتب :السلام عليكم
كود :
Private Function GetFileName(sFile As String) As String
On Error Resume Next: Err.Clear
If InStr(1, sFile, "\") = 0 Then GetFileName = sFile: Exit Function
sFile = StrReverse(sFile)
sFile = Left$(sFile, InStr(1, sFile, "\") - 1)
GetFileName = StrReverse(sFile)
End Function
Private Function GetFilePath(gFile As String) As String
On Error Resume Next: Err.Clear
If InStr(1, gFile, "\") = 0 Then GetFilePath = gFile: Exit Function
gFile = StrReverse(gFile)
gFile = Mid$(gFile, InStr(1, gFile, "\"))
GetFilePath = StrReverse(gFile)
End Function
Private Function Is_InListView(sFileName As String) As Boolean
On Error Resume Next: Err.Clear
Dim H As Integer
For H = 1 To ListView1.ListItems.Count
If Trim$(sFileName) = Trim$(ListView1.ListItems.Item(H).Text) Then
Is_InListView = True
DoEvents
Exit Function
End If
Next
Is_InListView = False
DoEvents
End Function
Private Sub Command1_Click()
On Error Resume Next: Err.Clear
CommonDialog1.FileName = ""
CommonDialog1.Filter = "All Files|*.*"
CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
CommonDialog1.ShowOpen
If Trim$(CommonDialog1.FileName) = "" Then Exit Sub
Dim vFiles As Variant
Dim iFile As Long
Dim zItem As ListItem
Dim zFilesPath As String
Me.MousePointer = 11
vFiles = Split(CommonDialog1.FileName, Chr$(0))
DoEvents
If UBound(vFiles) = 0 Then
zFilesPath = GetFilePath(Trim$(vFiles(0)))
DoEvents
If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
If Is_InListView(Trim$(GetFileName(Trim$(vFiles(0))))) = False Then
Set zItem = ListView1.ListItems.Add(, , GetFileName(Trim$(vFiles(0))), 1, 1)
DoEvents
End If
Else
zFilesPath = Trim$(vFiles(0))
DoEvents
If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
For lFile = 1 To UBound(vFiles)
If Is_InListView(Trim$(vFiles(lFile))) = False Then
Set zItem = ListView1.ListItems.Add(, , Trim$(vFiles(lFile)), 1, 1)
DoEvents
End If
Next
End If
Me.MousePointer = 0
End Sub
جزاك الله كل خير اخي الكريم
وغفر لنا ولك ولوالديك
جاري التجربة
