Dim ThisPath As String
Dim j As Integer
Dim RowCount As Integer
ThisPath = Textpath
Dim ArrayRow(100) As String, Result(100) As String
Dim searchChar As String
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim readFile As Scripting.TextStream
Dim readString As String
If Not fso.FileExists(ThisPath) Then
MsgBox ("原文件不存在")
Exit Sub
Else
Set readFile = fso.OpenTextFile(ThisPath)
'赋初值
RowCount = 0
'读写文件
Do While Not readFile.AtEndOfStream
Dim k, l, l0, p1, p2 As Integer
readString = readFile.ReadLine
searchChar = "$"
l = 0 '字段长度
l0 = 0 '总长度
p1 = 1
p2 = 0 '下一个位置
Dim Value
Dim temp_value
Dim Sub_value
Dim temp_result
temp_value = "222"
Sub_value = "333"
temp_result = "444"
For j = 1 To ColumCount '每一字段
If InStr(p1, readString, searchChar, 1) = 0 Then
If (Sub_value = temp_value) Then
Value = ""
Else
Value = Mid(readString, p1, Len(readString) - p1 + 1)
temp_value = Value
Sub_value = Value
End If
Else
p2 = InStr(p1, readString, searchChar, 1)
Value = Mid(readString, p1, p2 - p1)
End If
ArrayRow(j) = Value
p1 = p2 + 1
Next j
For j = 1 To ColumCount
Result(j) = ArrayRow(j)
Next j
ThisWorkbook.Sheets("例子页").Range("Rag").Offset(RowCount) = Result
RowCount = RowCount + 1
Loop
End If
readFile.Close
Set readFile = Nothing
Set fso = Nothing
Dat2SQL = True
ThisWorkbook.Application.ScreenUpdating = True
ThisWorkbook.Application.DisplayAlerts = True
ThisWorkbook.Application.ScreenUpdating = True
End Sub
end ;
function GetPathFromFullPath(fp:string):string;
function GetsheetName(WorkName,SheetName :string):OLEVariant;
procedure Exe_excel(WorkName,SheetName :String ) ;
implementation
function GetsheetName(WorkName,SheetName :string):OLEVariant;
var
aExcel, aWorkbook, aSheet : OLEvariant;
begin
result := UnAssigned;
try
aExcel := GetActiveOleObject('Excel.Application');
except
try
aExcel := CreateOLEObject('Excel.Application');
except
ShowMessage('无法启动Excel!');
exit;
end;
end;
aWorkBook := aExcel.Workbooks.Open(WorkName);
aSheet := aWorkBook.Worksheets.item[SheetName];
result := aSheet;
end;
procedure Exe_excel(WorkName,SheetName :String ) ;
var app,aSheet :OleVariant ;
begin
aSheet := GetSheetName
(ExtractFilePath(Application.EXEName)+ WorkName ,SheetName);
function TExecExcel.GetClToken(var S: string; delim: string): string;
var I: integer;
begin
I:=pos(delim,s);
if I<>0 then
begin
result:=Copy(S,1,I-1);
S:=Copy(S,I+length(delim),length(S));
end
else
begin
Result:=S;
S:='';
end;
end;
function GetPathFromFullPath(fp: string): string;
var path :String;
L,I :integer;
begin
path:='';
L:=0;
For I:=length(fp) downto 1 do
begin
if fp[i]='\' then
begin
L:=I;
break;
end;
end;
path:=fp;
setlength(path,L);
result:=path;
end;
function TExecExcel.GetSheet(ExcelTamplateName,
SheetName: String): OLEVariant;
var
aExcel, aWorkbook, aSheet : OLEvariant;
begin
result := UnAssigned;
try
aExcel := GetActiveOleObject('Excel.Application');
except
try
aExcel := CreateOLEObject('Excel.Application');
except
ShowMessage('无法启动Excel!');
exit;
end;
end;
aWorkBook := aExcel.Workbooks.Add(ExcelTamplateName);
aSheet := aWorkBook.Worksheets.item[SheetName];
result := aSheet;
end;
procedure TExecExcel.WriteData(SourceData: TCustomADODataSet; DestFile : String);
var F: TextFile;
S: String;
I:integer;
AppPath:String;
begin
S:='';
AppPath:= GetPathFromFullPath(Application.ExeName) ;
AssignFile(F, AppPath+DestFile);
Rewrite(F);
SourceData.First;
Try
SourceData.DisableControls;
While not SourceData.eof do
begin
for I:=0 to SourceData.FieldCount-1 do
begin
if SourceData.Fields[I].DataType=FtString then
S:=S+'"'+SourceData.Fields[I].asstring+'"'+','
Else
S:=S+SourceData.Fields[I].asstring+',';
SourceData.First;
Try
SourceData.DisableControls;
While not SourceData.eof do
begin
for I:=0 to SourceData.FieldCount-1 do
S:=S+SourceData.Fields[I].asstring+'$';
ExcelApplication1.Workbooks.Add(NULL,0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Sheets[1] as _WorkSheet);
for idx:=1 to 30 do begin
ExcelWorksheet1.Cells.Item[idx,1]:='Hello '+IntToStr(idx);
ExcelWorksheet1.Cells.Item[idx,2]:= idx;
end;
ExcelWorksheet1.Cells.Item[31,2]:='=SUM(B1:B30)';
ShowMessage('Total is '+ExcelWorksheet1.Cells.Item[31,2]);