Excel VBA - 文件名

Question

我正在尝试从照片目录中获取图像列表

PC_12321.jpg
PC_12321_1.jpg
PC_12321_2.jpg
PC_23255.jpg
PC_23255_1.jpg
PC_23255_2.jpg
HRK_23255.jpg
HRK_23255_1.jpg
HRK_23255_2.jpg

让他们填充并优秀列为

PC_12321
PC_23255
HRK_23255

代码为每个额外文件提供额外的空白行

我现在得到的结果：

我能得到的任何帮助都会很精彩。

Sub getfilenew()

Dim varDirectory As Variant
Dim flag As Boolean
Dim i As Integer
Dim strDirectory As String
Dim fname As String
Dim fnloc As Integer
Dim oldfname As String

0 strDirectory = "C:\photo\2edited\"
i = 1
flag = True

varDirectory = Dir(strDirectory & "*.jpg", vbNormal)
While flag = True
    If varDirectory = "" Then
        flag = False
    Else
  fnloc = InStr(5, varDirectory, "_")
  'fnloc will contain the postion of the first underscore in the filemane after the 5th character (handles both 2 and 3 char)
  If fnloc > 0 Then
   fname = Mid(varDirectory, 1, fnloc - 1) + ".jpg"

      'strip off all the characters after a second underscore, add the .jpg back in
  'MsgBox (FTest)
  Else
     fname = varDirectory
End If
  varDirectory = Left(fname, Len(fname) - 4)
 'MsgBox ("old filename:  " + oldfname)
  If oldfname <> fname Then  'skip duplicates
        i = i + 1
    'Cells(i + 1, 1) = varDirectory
  End If
  oldfname = fname
        varDirectory = Dir
        i = i + 1
    End If
Wend
End Sub

Answer 1

尝试删除最后一个i = i + 1