2015-07-28 224 views
2

我將文件名從文件夾存儲到數組中。然後,我試圖從文件名中刪除字符串的「.xlsx」部分,並將它們打印到電子表格中。 我很難從每個數組元素中刪除「.xlsx」子字符串。我被引導認爲Replace函數是最好的,但還沒有成功。混亂的區域由'HERE註釋指示vba - 從每個字符串數組中刪除子字符串

Sub Example() 

    Dim FName As String 
    'Array to store filenames. 
    Dim arNames() As String 
    Dim myCount As Integer 
    Dim i As Integer 

    FName = Dir("G:\ExampleFolder\*.xls*") 
    ' Run until there are no more filenames. 
    Do Until FName = "" 
     'Increment 
     myCount = myCount + 1 
     'Actively store filenames into an array. 
     ReDim Preserve arNames(1 To myCount) 
     arNames(myCount) = FName 
     FName = Dir 
    Loop 

    'Print array details to sheet. 
    For i = LBound(arNames) To UBound(arNames) 
    Next i 

    'Create a random excel sheet to print the file names. 
    Set o = CreateObject("excel.application") 
    ' Activate new excel spreadsheet. 
    o.Visible = True 
    o.Workbooks.Add 
    'Edit string in array. 

    'HERE 
    Dim LResult As String 
    'LResult = Replace(arNames, ".xlsx", "") 

    o.sheets("sheet1").Range("A1:" & ConvertToLetter(i) & "1").Value = arNames 

End Sub 



    Function ConvertToLetter(iCol As Integer) As String 
    Dim iAlpha As Integer 
    Dim iRemainder As Integer 
    iAlpha = Int(iCol/27) 
    iRemainder = iCol - (iAlpha * 26) 
    If iAlpha > 0 Then 
     ConvertToLetter = Chr(iAlpha + 64) 
    End If 
    If iRemainder > 0 Then 
     ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) 
    End If 
End Function 

回答

5

的原因是,你正在試圖通過可變arNames這是一個字符串數組,應該是String功能Replace的第一參數(注意之間的差字符串和字符串數組)。

您需要更換這些代碼行:與一個

Dim LResult As String 
'LResult = Replace(arNames, ".xlsx", "") 

For i = LBound(arNames) To UBound(arNames) 
    arNames(i) = Replace(arNames(i), ".xlsx", "") 
Next i 
+0

完美,非常感謝你! – AMorton1989

0

Next i是放錯了地方?;我想,你希望從A1水平文本,以取代'Print array details to sheet.下的一切:

'// create an instance once; 
Set o = CreateObject("excel.application") 
o.Visible = True 
o.Workbooks.Add 

'// get the startcell 
Dim startCell As Range 
Set startCell = o.Sheets("sheet1").Range("A1") 

'// loop removing the extension and writing 
For i = LBound(arNames) To UBound(arNames) 
    startCell.Offset(0, i - 1).Value = Mid$(arNames(i), 1, InStrRev(arNames(i), ".")) 
Next