文件复制改名后读取错误的问题,附代码。
’这段是复制图片文件代码Sub 复制文件()
Dim sFilename As String
'保存图片
SelectFile = CommonDialog1.FileName '获取选择的文件
s1 = Split(SelectFile, Chr(0))
If UBound(s1) >= 0 Then '选择了图片
If UBound(s1) = 0 Then '只有一张图片执行
If Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & Mid$(s1(0), InStrRev(s1(0), "\") + 1), vbNormal) <> "" Then '存在文件
fs1 = Mid$(s1(0), InStrRev(s1(0), "\") + 1) '截取文件名
Fl = Mid(s1(0), InStr(s1(0), ".")) '截取文件后面的后缀
i = 0
AAA:
F2 = ""
F2 = Format(Left(fs1, InStr(fs1, ".") - 1) & i & Fl) '将文件名增加数字i后在下面判断改名后的图片是否存在
If Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & F2, vbNormal) <> "" Then '如果存在
i = i + 1
GoTo AAA
Else
FileCopy s1(0), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & F2 & "" '图片改名后存储
End If
Else
FileCopy s1(0), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & CommonDialog1.FileTitle & "" '单张图片存储
End If
Else '不是一张图片
For i1 = 1 To UBound(s1) '循环复制图片
If Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & Mid$(s1(i1), InStrRev(s1(i1), "\") + 1), vbNormal) <> "" Then '存在文件
fs1 = Mid$(s1(i1), InStrRev(s1(i1), "\") + 1) '截取文件名
Fl = Mid(s1(i1), InStr(s1(i1), ".")) '截取文件后面的后缀
i = 0
BBB:
F2 = ""
F2 = Format(Left(fs1, InStr(fs1, ".") - 1) & i & Fl) '将文件名增加数字i后在下面判断是否存在
If Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & F2, vbNormal) <> "" Then '如果存在
i = i + 1
GoTo BBB
Else
'FileCopy s1(0), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & F2 & "" '单张图片存储
FileCopy s1(0) & "\" & s1(i1), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & F2 '多张图片存储
End If
Else
'FileCopy s1(0), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & CommonDialog1.FileTitle & "" '单张图片存储
FileCopy s1(0) & "\" & s1(i1), "" & App.Path & "\物品图片\" & Trim(Text1(0).Text) & "\" & s1(i1) '多张图片存储
End If
Next
End If
End If
End Sub
’下面是加载图片文件名到列表
Sub 加载图片()
List1.Clear
'判断图片是否存在
If Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & "", vbDirectory) <> "" Then '如果文件夹内有文件
myFile = Dir("" & App.Path & "\物品图片\" & Trim(Text1(0).Text + "\") & "*.*", vbNormal) ''获得符合条件的文件名
Do While MyFile <> "" ''循环查找
List1.AddItem MyFile ''添加到list列表
MyFile = Dir ''如果和上次一样
Loop
If List1.ListCount > 0 Then
Image1.Picture = LoadPicture(xsapptp & List1.List(0))
End If
End If
End Sub
’下面是点击列表框文件名显示图片,就是这个出错,没有改名过的文件可以正常显示,改名后的文件就报文件名错误
Private Sub List1_Click() '单击列表框文件名显示图片
On Error GoTo ErrH
If List1.ListCount > 0 Then Image1.Picture = LoadPicture(List1.List(List1.ListIndex)) '自动显示选中的第一张图片
Exit Sub
ErrH:
If Err = 53 Then
MsgBox "图片文件错误!", 48, "仓库管理系统"
End If
End Sub