в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:09Z

1 версия

Новая страница

==Brings up a dialog box that asks the user for a filename.==



<source lang="vb">

Sub GetImportFileName()
Dim Finfo As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant
FInfo = "Text Files (*.txt),*.txt," & _
"Lotus Files (*.prn),*.prn," & _
"Comma Separated Files (*.csv),*.csv," & _
"ASCII Files (*.asc),*.asc," & _
"All Files (*.*),*.*"
" Display *.* by default
FilterIndex = 5
Title = "Select a File to Import"
FileName = Application.GetOpenFilename(FInfo,FilterIndex, Title)
If FileName = False Then
MsgBox "No file was selected."
Else
MsgBox "You selected " & FileName
End If
End Sub
</source>

==Create text file based database==



<source lang="vb">

Sub TextExample()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sCS As String
Dim sSQL As String
Set cn = New ADODB.Connection
sCS = "DefaultDir=C:\;"
sCS = sCS & "Driver={Microsoft Text Driver (*.txt; *.csv)};"
sCS = sCS & "DriverId=27;"
cn.ConnectionString = sCS
cn.Open
Debug.Print cn.ConnectionString
On Error Resume Next
cn.Execute "CREATE TABLE [newfile.txt] (FirstName TEXT, LastName TEXT);"
If Err.Number <> 0 And Err.Number <> vbObjectError + 3604 Then
Debug.Print Err.Number & ": " & Err.Description
Exit Sub
End If
sSQL = "INSERT INTO [newfile.txt] (FirstName, LastName) Values ("steve", "roman");"
cn.Execute sSQL
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM NewFile.txt", cn, adOpenDynamic, adLockOptimistic
Debug.Print rs.Supports(adAddNew)
Debug.Print rs.Supports(adBookmark)
Debug.Print rs.Supports(adDelete)
Debug.Print rs.Supports(adFind)
Debug.Print rs.Supports(adUpdate)
Debug.Print rs.Supports(adMovePrevious)

rs.Close
cn.Close
End Sub
</source>

==Export active worksheet to CSV file==



<source lang="vb">

Sub ExportActiveWorksheet()
Dim oldname$, oldpath$, oldformat
Application.DisplayAlerts = False "avoid safetey alert
With ActiveWorkbook
oldname = .Name
oldpath = .Path
oldformat = .FileFormat
.ActiveSheet.SaveAs _
Filename:="c:\file.csv", FileFormat:=xlCSV
.SaveAs Filename:=oldpath + "\" + oldname, FileFormat:=oldformat
End With
Application.DisplayAlerts = True
End Sub
</source>

==Query text file==



<source lang="vb">

Public Sub QueryTextFile()
Dim Recordset As ADODB.Recordset
Dim ConnectionString As String
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";" & _
"Extended Properties=Text;"

Const SQL As String = "SELECT * FROM Sales.csv WHERE Type="Art";"

Set Recordset = New ADODB.Recordset
Call Recordset.Open(SQL, ConnectionString, CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
Call Sheet1.Range("A1").CopyFromRecordset(Recordset)
Recordset.Close
Set Recordset = Nothing
End Sub
</source>

==Saves the active worksheet in the workbook named MyWorkbook.xls as a comma-delimited text file named test.csv:==



<source lang="vb">

Sub csvSave()
Workbooks("MyWorkbook.xls").SaveAs Filename:=ActiveWorkbook.Path & _
"\test.csv", FileFormat:=xlCSV
End Sub
</source>

==Split demonstration==



<source lang="vb">

Sub UsefulStringFunctions()
Dim sTestWord As String
sTestWord = "One, Two, Three, 4, Five, Six"
DemoSplit sTestWord
End Sub
Sub DemoSplit(sCSV As String)
Dim vaValues As Variant
Dim nIndex As Integer
vaValues = Split(sCSV, ",")
For nIndex = 0 To UBound(vaValues)
Debug.Print "Item (" & nIndex & ") is " & vaValues(nIndex)
Next
End Sub
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/File Path/CSV - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия