2/02/2012

讓使用者選擇多個檔案匯入EXCEL中

如果要把一個txt檔匯入EXCEL中,很快,沒甚麼問題。但如果要連續匯入很多個的話,那就需要拜託VBA了~~~

個人很懶,平常沒事都會選擇不碰它,但是要懶得有方法啊!!
如果有東西能夠縮短平時的作業程序為什麼不用呢~


程式碼:
Sub OpenFile()
Dim strFilt As String
Dim strTitle As String
Dim strFname As Variant
Dim i As Integer
Dim strMsg As String

strFilt = "文字檔案,*.txt,"
strTitle = "打開Excel文件"
strFname = Application.GetOpenFilename(FileFilter:=strFilt, Title:=strTitle, MultiSelect:=True)
If Not IsArray(strFname) Then
MsgBox "沒選擇文件!"
Else
For i = LBound(strFname) To UBound(strFname)
strMsg = strMsg & strFname(i) & vbCrLf
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFname(i), Destination:=Range("$A$1"))
.Name = "18"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileFixedColumnWidths = Array(14)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
MsgBox "選擇的文件是:" & vbCrLf & strMsg
End If

End Sub


這小小的一段能夠讓使用者自己選擇要匯入哪一些txt檔案。
雖然短短的,但是對非本科系的我來說,卻花了一點時間才寫完,滿有成就感的^^