首頁 資料庫 mysql教程 将数据导出至 M$ Access

将数据导出至 M$ Access

Jun 07, 2016 pm 03:32 PM
access dev express 匯出 數據

Dev Express 中的 dxDBGrid/cxGrid 均提供了将表格中 数据 导出 到 M$ Excel 等中的方法,但大多时候,却需将 数据 导出 至 M$ Access 中... 于是便有了本文。 uses ComObj, Gauges, ShellAPI; const ExportTabName_MDB = '营销 数据 '; MDBStr = 'Provider=

Dev Express 中的 dxDBGrid/cxGrid 均提供了将表格中数据导出到 M$ Excel 等中的方法,但大多时候,却需将数据导出至 M$ Access 中...
    于是便有了本文。

    uses
      ComObj, Gauges, ShellAPI;

    const
      ExportTabName_MDB = '营销数据';
      MDBStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s';

    var
      ExportName: string;
      ExportColumnLst: TStringList; //列名;列类型(长度)
    begin
      ExportName:= '导出结果.MDB'; //use a SaveDialog to select the save name here
      ExportColumnLst:= TStringList.Create;

      //(示例)导出列列表,注意 格式
      ExportColumnLst.Add('Contact;联系人 varchar(30)');
      ExportColumnLst.Add('Gender;性别 varchar(2)');
      ExportColumnLst.Add('Address;地址 varchar(100)');
      ExportColumnLst.Add('PostCode;邮编 varchar(6)');

      try
        ExportToMDB(ExportName, ExportColumnLst);
      finally
        FreeAndNil(ExportColumnLst);
      end;
    end;

    procedure ExportToMDB(ExportMDBName: string; ExportColumnLst);
      function CreateMDB(MDBFileName: string): Boolean;
      var
        vMDB: Variant;
      begin
        Result:= False;

        vMDB:= CreateOleObject('ADOX.Catalog');
        vMDB.Create(Format(MDBStr, [MDBFileName]));
        vMDB:= UnAssigned;

        Result:= True;
      end;

      function CreateTab(MDBAndTabName: string; ExportColumnLst: TStringList;
        aqy_ExecSQL: TADOQuery): Boolean;
      var
        i: Integer;
        StrTmp: string;
        SQLTxt: string;
        MDBName: string;
        TabName: string;
      begin
        Result:= False;

        SQLTxt:= '';
        for i:= 0 to ExportColumnLst.Count - 1 do
        begin
          StrTmp:= ExportColumnLst.Strings;

          if SQLTxt = '' then
            SQLTxt:= Copy(StrTmp, Pos(';', StrTmp) + 1, Length(StrTmp));
          else
            SQLTxt:= SQLTxt + ',' +
                       Copy(StrTmp, Pos(';', StrTmp) + 1, Length(StrTmp));
        end;

        MDBName:= Copy(MDBAndTabName, 1, Pos(';', MDBAndTabName) - 1);
        TabName:= Copy(
                       MDBAndTabName,
                       Pos(';', MDBAndTabName) + 1,
                       Length(MDBAndTabName)
                      );

        with aqy_ExecSQL do
        try
          Close;

          ConnectionString:=
            'Provider=MSDataShape.1;Data Provider=Microsoft.Jet.OLEDB.4.0;' +
            'Data Source=' + MDBName + ';Persist Security Info=false';

          SQL.Text:=
            'create table ' + TabName +
            '(' +
              SQLTxt +
            ')';

          try
            ExecSQL;
            Close;
          except
            on E: Exception do
            begin
              MessageBox(
                         Handle,
                         PChar('创建表失败!' + #13 + '失败原因:' + E.Message),
                         '错误',
                         MB_OK + MB_ICONERROR
                        );
              Close;
              Exit;
            end;  
          end;          
        finally
          //Free;  
        end;

        Result:= True;
      end;
    var
      aqy_ExecSQL: TADOQuery;
      SQLTxt: string;
      i: Integer;
      StrTmp: string;
      ExportColumn: string;
      ExportColumnParam: string;
      ExportParamLst: TStringList;
      GgTip: TGauge;
      CurrRec: Integer;
    begin
      if CreateMDB(ExportMDBName) then
      begin
        aqy_ExecSQL:= TADOQuery.Create(Self);
        try
          if CreateTab(
                       ExportMDBName + ';' + ExportTabName_MDB,
                       ExportColumnLst,
                       aqy_ExecSQL
                      ) then
          begin
            Screen.Cursor:= crHourGlass;

            ExportColumn:= '';
            ExportColumnParam:= '';
            ExportParamLst:= TStringList.Create;
            for i:= 0 to ExportColumnLst.Count - 1 do
            begin
              StrTmp:= ExportColumnLst.Strings;

              if ExportColumn = '' then
              begin
                ExportColumn:= Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
                ExportColumnParam:= ':' + ExportColumn;
                ExportParamLst.Add(ExportColumn);
              end
              else
              begin
                ExportColumn:= ExportColumn + ',' +
                                 Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
                ExportColumnParam:= ExportColumnParam + ',:' +
                                      Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
                ExportParamLst.Add(Copy(StrTmp, 1, Pos(';', StrTmp) - 1));
              end;
            end;

            SQLTxt:=
              'select ' + ExportColumn + ' from TabName where ID=' +
              aqy_Tmp1.FieldByName('ID').AsString;  

            try
              with aqy_ExportData do //aqy_ExportData: TADOQuery;
              begin
                Close;
                SQL.Text:= SQLTxt;
                Open;

                //pnl_ExportFile: TPanel;
                GgTip:= TGauge.Create(pnl_ExportFile); //Gauge 进度提示
                with GgTip do
                begin
                  Parent:= pnl_ExportFile;
                  Left:= 0;
                  Height:= 21;
                  Width:= pnl_ExportFile.Width;
                  ForeColor:= clFuchsia;
                  MinValue:= 0;
                  MaxValue:= RecordCount;
                  Visible:= True;
                  Update;
                end;

                CurrRec:= 0;
                while not Eof do
                begin
                  Inc(CurrRec);

                  if CurrRec mod 20 = 0 then
                  begin
                    GgTip.Progress:= CurrRec;
                    Update;

                    Application.ProcessMessages;
                  end;

                  with aqy_ExecSQL do
                  begin
                    Close;

                    SQL.Text:=
                      'Insert Into ' + ExportTabName_MDB +
                      ' Values(' + ExportColumnParam + ')';

                    for i:= 0 to ExportParamLst.Count - 1 do
                      Parameters.ParamByName(ExportParamLst.Strings).Value:=
                       aqy_ExportData.FieldByName(
                                                  ExportParamLst.Strings
                                                 ).AsString;

                    try
                      ExecSQL;                  
                    except
                      on E: Exception do
                      begin
                        Close;
                        GgTip.Visible:= False;
                        Update;

                        MessageBox(
                                   Handle,
                                   PChar('导出文件失败! ' + #13 + '失败原因:' +
                                         E.Message + ' '
                                        ),
                                   '错误',
                                   MB_OK + MB_ICONERROR
                                  );
                        Exit;
                      end;
                    end;
                  end; //End with

                  aqy_ExecSQL.Close;

                  Next;
                end; //End while

                Close; //aqy_ExportData
                GgTip.Visible:= False;

                if MessageBox(
                              Handle,
                              PChar('导出文件成功! ' + #13 +
                                    '现在查看导出结果(' + ExportMDBName + '吗?'
                                   ),
                              '提示',
                               MB_YESNO + MB_ICONINFORMATION
                             ) = IDYES then
                begin
                  ShellExecute(0, 'Open', PChar(ExportMDBName), nil, nil, SW_SHOW);
                end;
              end;
            except
              on E: Exception do
              begin
                pnl_ExportFile.Caption:= '';
                GgTip.Visible:= False;
                Update;

                MessageBox(
                           Handle,
                           PChar('导出文件过程中发生错误! ' + #13 +
                                 '错误描述:' + E.Message + ' '
                                ),
                           '导出失败',
                           MB_OK + MB_ICONERROR
                          );
              end;
            end;
          end;
        finally
          FreeAndNil(aqy_ExecSQL);
          FreeAndNil(ExportParamLst);
          FreeAndNil(GgTip);

          Screen.Cursor:= crDefault;
        end;
      end;
    end;

    OK,Done!

ADelphiCoder

本網站聲明
本文內容由網友自願投稿,版權歸原作者所有。本站不承擔相應的法律責任。如發現涉嫌抄襲或侵權的內容,請聯絡admin@php.cn

熱AI工具

Undresser.AI Undress

Undresser.AI Undress

人工智慧驅動的應用程序,用於創建逼真的裸體照片

AI Clothes Remover

AI Clothes Remover

用於從照片中去除衣服的線上人工智慧工具。

Undress AI Tool

Undress AI Tool

免費脫衣圖片

Clothoff.io

Clothoff.io

AI脫衣器

AI Hentai Generator

AI Hentai Generator

免費產生 AI 無盡。

熱門文章

R.E.P.O.能量晶體解釋及其做什麼(黃色晶體)
2 週前 By 尊渡假赌尊渡假赌尊渡假赌
倉庫:如何復興隊友
4 週前 By 尊渡假赌尊渡假赌尊渡假赌
Hello Kitty Island冒險:如何獲得巨型種子
3 週前 By 尊渡假赌尊渡假赌尊渡假赌

熱工具

記事本++7.3.1

記事本++7.3.1

好用且免費的程式碼編輯器

SublimeText3漢化版

SublimeText3漢化版

中文版,非常好用

禪工作室 13.0.1

禪工作室 13.0.1

強大的PHP整合開發環境

Dreamweaver CS6

Dreamweaver CS6

視覺化網頁開發工具

SublimeText3 Mac版

SublimeText3 Mac版

神級程式碼編輯軟體(SublimeText3)

Windows11怎麼停用後台應用程式_Windows11停用後台應用程式教學 Windows11怎麼停用後台應用程式_Windows11停用後台應用程式教學 May 07, 2024 pm 04:20 PM

Windows11怎麼停用後台應用程式_Windows11停用後台應用程式教學

超級智能體生命力覺醒!可自我更新的AI來了,媽媽再也不用擔心資料瓶頸難題 超級智能體生命力覺醒!可自我更新的AI來了,媽媽再也不用擔心資料瓶頸難題 Apr 29, 2024 pm 06:55 PM

超級智能體生命力覺醒!可自我更新的AI來了,媽媽再也不用擔心資料瓶頸難題

deepseek怎麼轉換pdf deepseek怎麼轉換pdf Feb 19, 2025 pm 05:24 PM

deepseek怎麼轉換pdf

iPhone上的蜂窩數據網路速度慢:修復 iPhone上的蜂窩數據網路速度慢:修復 May 03, 2024 pm 09:01 PM

iPhone上的蜂窩數據網路速度慢:修復

美國空軍高調展示首個AI戰鬥機!部長親自試駕全程未乾預,10萬行代碼試飛21次 美國空軍高調展示首個AI戰鬥機!部長親自試駕全程未乾預,10萬行代碼試飛21次 May 07, 2024 pm 05:00 PM

美國空軍高調展示首個AI戰鬥機!部長親自試駕全程未乾預,10萬行代碼試飛21次

特斯拉機器人進廠打工,馬斯克:手的自由度今年將達到22個! 特斯拉機器人進廠打工,馬斯克:手的自由度今年將達到22個! May 06, 2024 pm 04:13 PM

特斯拉機器人進廠打工,馬斯克:手的自由度今年將達到22個!

field在java中是什麼意思 field在java中是什麼意思 Apr 25, 2024 pm 10:18 PM

field在java中是什麼意思

單卡跑Llama 70B快過雙卡,微軟硬生把FP6搞到A100哩 | 開源 單卡跑Llama 70B快過雙卡,微軟硬生把FP6搞到A100哩 | 開源 Apr 29, 2024 pm 04:55 PM

單卡跑Llama 70B快過雙卡,微軟硬生把FP6搞到A100哩 | 開源

See all articles