Excel VBA腳本將列複製到單獨的目錄下的單獨文本文件

Question

我有一個工作表，其中包含27列，第一行是A-Z和NUM共27列的列標題。每一列都有一列非常長的受限制網址列表，並按照列的字母排序，最後一列（第27列）用於以數字開頭的網址。專欄的長度在300-600千個細胞之間。

我所追求的是將每列拷貝到單獨的文件夾下的單獨的文本文件（* .file），即列A將被複制並保存到c：/blacklist/A/a.file，等等因此，我們將c：/blacklist/B/b.file一直保存到c：/blacklist/NUM/num.file。

我一直在尋找解決的辦法，發現下面的VBA腳本，什麼我後，這是非常接近，網址爲：http://www.ozgrid.com/forum/showthread.php?t=142181

Option Explicit 

Public Sub Columns_2_TextFile() 

Const My_Path = "C:\TEXTFILES\" 
Dim iCol As Integer 
Dim lRow As Long 
Dim File_Num As Long 

On Error Resume Next 
If Trim(Dir(My_Path, vbDirectory)) = "" Then 
    MkDir My_Path 
Else 
    Kill My_Path & "*.txt" 
End If 
On Error Goto 0 
File_Num = FreeFile 
With ActiveSheet 
    For iCol = 2 To 256 
     Open My_Path & Trim(.Cells(2, iCol).Value) & ".txt" For Output As #File_Num 
     For lRow = 3 To .Cells(Rows.Count).End(xlUp).Row 
      Print #File_Num, .Cells(lRow, iCol).Value 
     Next 
     Close #File_Num 
    Next 
End With 

MsgBox "All files created and saved to : " & My_Path 

End Sub 

有兩個問題與此腳本： 首先是它不會在單獨的文件夾下創建文本文件，而是會在ONE文件夾下創建所有文件。 第二個是當我嘗試它時，它沒有複製創建的文件中的列內容，換句話說，文件是空的，零內容。

Answer 1

我沒有測試過，所以沒有保證。您需要將「Sheet1」更改爲您的工作表名稱。

Public Sub Main() 
Dim Path As String: Path = "C:\blacklist\" 
Dim Column As Integer 
Dim Row As Long 
Dim Name As String 
Dim File As Long 
Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1") 

For Column = 1 To 27 
    Name = Sheet.Cells(1,Column).Value2 
    On Error Resume Next 
    If Trim(Dir(Path & Name & "\", vbDirectory)) = "" Then 
     MkDir Path & Name & "\" 
    Else 
     Kill Path & Name & "\*.file" 
    End If 
    On Error Goto 0 
    File = FreeFile 
    Open Path & Name & "\" & Name & ".file" For Output As #File 
     For Row = 2 To Sheet.Cells(Sheet.Rows.Count, Column).End(xlUp).Row ' fixed 
      Print #File, Sheet.Cells(Row, Column).Value2 
     Next Row 
    Close #File 
Next Column 

End Sub 

更新應該現在的工作。