.txt 文本导入access 不能全部导入的问题
我用ADO连接MDB 导入一个文本 大致如下:
1&01&鄂A01062&2007-4-12 8:15:00&武当山城区0000公里000米附近&1229&420319
2&01&鄂A01245&2006-9-8 11:14:00&316国道六里坪段1601公里000米附近&1303&420318004
3&01&鄂A01367&2007-5-25 17:29:00&武当山城区0000公里000米附近&1229&420319
由于长度不是一致的 我采用的是一条一条的导入 几千条导入没有什么问题 但是我有大约20万条要导入
每次程序一运行几秒钟 就不运行了 也未报任何错误 但仅导入了1万多条 不知道是什么原因
请高手指点一下 是程序有错还是数据库的设置问题
程序代码如下:
Function RegulateStr(aString:String;Sepchar:String):String;
var
i,NUM: integer;
Flag: Boolean;
MyStr,TempStr: String;
begin
Flag:=False;
Num:=Length(aString);
sepchar:='&';
for i:=1 to Num do
begin
TempStr:=Copy(aString,i,1);
if TempStr<>SepChar then
begin
MyStr:=MyStr+TempStr;
Flag:=True;
end
else
if(Flag=True)then
begin
Mystr:=Mystr+TempStr;
Flag:=False;
end;
end;
if MyStr[Length(MyStr)]<>SepChar then
MyStr:=MyStr+SepChar;
RegulateStr:=MyStr;
end;
Function GetSubStr(var aString:String;SepChar:String):String;
var
Mystr:String;
StrLen:Integer;
SepCharPos:Integer;
begin
sepchar:='&';
StrLen:=Length(aString);
SepCharPos:=Pos(SepChar,aString);
MyStr:=Copy(aString,1,SepCharPos-1);
Delete(aString,1,SepCharPos);
GetSubStr:=MyStr;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i,j:integer;
myline:string;
begin
if edit1.Text<>'' then
begin
with adoquery1 do
begin
close;
sql.Clear;
sql.Add('delete from data');
execsql;
end;
with adotable1 do
begin
open;
for i:=0 to RichEdit1.Lines.Count-1 do
begin
MyLine:=RegulateStr(Richedit1.Lines[i],Space);
for j:=0 to 6 do
begin
if j<>3 then
begin
if j=0 then
append
else
edit;
adotable1.Fields[j].AsString:=GetSubStr(MyLine,Space);
end
else
begin
edit;
adotable1.Fields[j].AsDateTime:=strtodatetime(GetSubStr(MyLine,Space));
end;
end;
try
post;
except
MessageDlg('数据添加失败!',mtError,[mbok],0);
end;
end;
end;
adotable1.Close;
showmessage('success!');
end;