削除クエリ実行時(2つのテーブルをリンク)に下記のエラーが出るときがある。
「指定されたテーブルから削除できませんでした。」
対象のクエリ編集画面にてF4を押す。
[固有のレコード] を [はい]に変更。
これで解決できる。
削除クエリ実行時(2つのテーブルをリンク)に下記のエラーが出るときがある。
「指定されたテーブルから削除できませんでした。」
対象のクエリ編集画面にてF4を押す。
[固有のレコード] を [はい]に変更。
これで解決できる。
概要:
複数ファイルに格納されているコード群をSQLServerからデータ取得後、ファイル毎に出力
流れ:
引数で渡されたコードファイルを順次開く
コードを取り出してSQL生成
SQL実行後、結果をTAB区切りで出力
Set oParam = WScript.Arguments Set ObjConn = CreateObject("ADODB.Connection") ObjConn.Open ("Provider=SQLOLEDB;Data Source=ZZZZZ;Initial Catalog=AAAAA;Integrated Security=SSPI;") Set objFso = CreateObject("Scripting.FileSystemObject") Set objRc = CreateObject("ADODB.Recordset") wkIN = "\\bbbbb\" wkOUT = "\\ccccc\" SQL = "Select * FROM xxxxxx where [ROW_ID] = '" For idx = 0 To oParam.Count - 1 FNAME = oParam(idx) Set objOUTF = objFso.CreateTextFile(wkOUT & "OUT_" & FNAME, True, True ) Set objINF = objFso.OpenTextFile(wkIN & FNAME, 1, False) If Err.Number <= 0 Then 'header objOUTF.WriteLine("HEADER tab tab") cntRec = 0 Do Until objINF.AtEndOfStream wkREC = trim(objINF.ReadLine) objRc.Open SQL & wkREC & "';", ObjConn If not objRc.EOF then Buffer = "" For i = 0 to objRc.Fields.Count - 1 wkFLD = objRc.Fields(i).Value If not IsNull(wkFLD) then wkFLD = Replace(wkFLD, vbtab, " ") Buffer = Buffer & wkFLD & vbtab Next objOUTF.WriteLine(Buffer) cntRec = cntRec + 1 END If objRc.Close Loop End If objINF.Close objOUTF.Close Next Set ObjConn = Nothing Set objFso = Nothing Set objRc = Nothing
HTA形式でMDB検索アプリを作ってみた。
※実質VBScript
参照先はMS-Access(MDB)でクライアント上で実行。
※サーバー不要
<HTML> <HEAD> <SCRIPT LANGUAGE="VBScript"> <!--
Option Explicit Function fncExec() Dim dbRes, tag Dim dbPath, dbe, db, s, CODEs, SQL if frm.CODE.Value="" then WScript.Quit() CODEs = replace(trim(frm.CODE.Value), ";", ",") dbPath = ".\xxxxxx.accdb" Set dbe = CreateObject("DAO.DBEngine.120") Set db = dbe.Workspaces(0).OpenDatabase(dbPath, False) SQL = "select * from zzzzzzzzzzz where CODE in(" & CODEs & ")" Set dbRes = db.OpenRecordset(SQL) If Not dbRes.EOF then s = "<table border=1><tr><th>AAA</th><th>BBB</th></tr>" Do Until dbRes.EOF s = s & "<tr><td>" & dbRes("AAA").Value & "</td><td>" & dbRes("BBB").Value & "</td><tr>" dbRes.movenext loop s = s & "</table>" & SQL Else s = s & "Not Found" End If objList.innerHTML = s db.Close Set db = Nothing Set dbe = Nothing End Function
--> </SCRIPT> </HEAD> <BODY> <FORM ID="frm"> CODE <INPUT ID="CODE" TYPE="TEXT" SIZE=30> <INPUT ID="EXEC" TYPE="BUTTON" VALUE="Go!" onClick="fncExec()"> </FORM> <DIV ID="objList"></DIV> <INPUT TYPE="BUTTON" VALUE="Close" onClick="window.close()"> </BODY> </HTML>
久し振りにVBAでIEを制御したのでメモ。
'定番 Dim ObjIE As Object Dim wkTEXT As String Set ObjIE = CreateObject("InternetExplorer.application") ObjIE.Visible = True ObjIE.Navigate "http://xxxxxxxx" 'WAIT Do While ObjIE.Busy Or ObjIE.ReadyState < READYSTATE_COMPLETE Debug.Print ObjIE.Busy & ":" & ObjIE.ReadyState DoEvents Loop 'INPUT FORM & SUBMIT ボタンなどがID化されてること ObjIE.Document.body.all("yyyyyy").Value = wkTAG ObjIE.Document.body.all("zzzzz").submit 'Other qqqqqqqqqq配下のHTMLを取り出し wkTEXT = ObjIE.Document.body.all("qqqqqqqqqq").Children(0).outerHTML 'Other ページのタイトル wkTEXT = ObjIE.Document.Title 'Other BODY内のテキスト wkTEXT = ObjIE.Document.Body.innerText
友人に頼まれて、かつJavaScriptとjQueryの勉強も兼ねてツールを作ってみた。
といってもいきなりは難しいから、Excel版でプロタイプを作ってみた。
風呂の中、電車の中でロジックを考えて、昼休みに一気に作り込み。
※電車の中でシェイプの使い方は事前勉強
1時間で出来たことは、我ながら。。。
でも、本命のWEB版は、、、挫折しそう。
Excel版の特徴:
'シェイプへの画像入れ込み、共通イベントの作成 Sub read_card_make_shape() Dim myFileName As String Dim myShape As Shape, item_name As String Dim D As String: D = Chr(34) Dim Y As Integer '事前準備した画像フォルダへのパス myFileName = "c:\temp\game.img\" Y = 2: Do While Sheets("data").Cells(Y, 1).Value <> "": Y = Y + 1: Loop: Y = Y - 1 For i = 2 To Y '画像ファイルをシェイプにセット Set myShape = ActiveSheet.Shapes.AddPicture( _ fileName:=myFileName & Sheets("data").Cells(i, 1).Value & ".jpg", _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=((i - 2) Mod 10) * 62, _ Top:=((i - 2) \ 10) * 92 + 250, _ Width:=60, _ Height:=90) 'シェイプに命名、クリック時のイベントにシェイプ名を渡す item_name = Sheets("data").Cells(i, 1).Value myShape.Name = item_name ActiveSheet.Shapes(item_name).OnAction = "'card_click" & D & item_name & D & "'" Next End Sub Sub card_click(KEY As String) 'クリックしたシェイプの名前をExcelセルへセット(あとはVlookup頼み) Dim YY As Integer YY = 3: Do While Sheets("main").Cells(YY, 1).Value <> "": YY = YY + 1: Loop If YY > 14 Then Exit Sub Sheets("main").Cells(YY, 1).Value = KEY End Sub Sub delete_line() '削除時は名称を消せば後の情報も自動で消える(Vlookup頼み) Dim YY As Integer YY = 2: Do While Sheets("main").Cells(YY, 1).Value <> "": YY = YY + 1: Loop Debug.Print YY If YY < 4 Then Exit Sub Sheets("main").Cells(YY - 1, 1).Value = "" End Sub
1,000をKで表示
1,000,000をMで表示
Excelの表示形式「ユーザ定義」で下記をセット
[>=1000000]#,###,,”M”;[>=1000]#,###,”K”;#,##0
VBAを使って、SQL Serverに接続するときの定義文。
SQLOLEDBで接続する場合:
OLEDB = “Provider=SQLOLEDB; Data Source=xxxx; User Id=xxxxx; Password=xxxx; Initial Catalog=xxxx;”
ODBCで接続する場合:
ODBC = “ODBC;DRIVER=SQL Server;SERVER=xxxxx;DATABASE=xxxxx;UID=xxxxx;PWD=xxxxx”
NTアカウントで接続する場合:
PERSIST SECURITY INFO=FALSE;
追記:
OLEDB or SQL CLIENT:
Integrated Security=SSPI;
ODBC:
Trusted_Connection=yes;
OracleClient:
Integrated Security=yes;
あるネットワーク上のファイル(今回はZIP)を一括ダウンロードする
前提:
手順:
下記説明:
'URLDownloadToFile API. Private Declare Function URLDownloadToFile Lib "urlmon" Alias _ "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _ szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Sub batch() Dim strFNAME As String, strSRC_FILE As String Dim strRET As Variant strFNAME = "c:\temp\download\" Open strFNAME & "_copy_list.txt" For Input As #1 Open strFNAME & "_report.txt" For Output As #2 Do While Not EOF(1) Line Input #1, strSRC_FILE strRET = download(strSRC_FILE, strFNAME & strSRC_FILE) Print #2, strRET & vbTab; strSRC_FILE Debug.Print strSRC_FILE DoEvents Loop Close MsgBox "done!" End Sub 'strURL:ダウンロード元URL(ファイル名のみ) 'strFNAME:格納先フルパス+ファイル名 Function download(strURL As String, strFNAME As String) As Variant Dim base_url As String base_url = "http://~~~~~~/~~~~~/" & strURL download = URLDownloadToFile(0, base_url, strFNAME, 0, 0) End Function
Google CalenderのデータをOutlookに取り込んだ後に印刷を行うという運用を想定。
毎回フィルタするのが面倒なので、自動化。
Sub auto_enabler_calender() Dim myCal As String Dim navModCal As CalendarModule myCal = "Google" Dim ContactsFolder As Folder Set ContactsFolder = Session.GetDefaultFolder(olFolderCalendar) Session.SendAndReceive (True) ContactsFolder.Display Set navModCal = ActiveExplorer.NavigationPane.Modules.GetNavigationModule(olModuleCalendar) 'show myCal calender For Each navGroup In navModCal.NavigationGroups For Each navFolder In navGroup.NavigationFolders Debug.Print navFolder.DisplayName If navFolder.DisplayName = myCal Then navFolder.IsSelected = True End If Next Next 'hide other calender For Each navGroup In navModCal.NavigationGroups For Each navFolder In navGroup.NavigationFolders Debug.Print navFolder.DisplayName If navFolder.DisplayName <> myCal Then navFolder.IsSelected = False End If Next Next End Sub
マクロでExcelグラフをGIF形式でファイル保存する。
'グラフタイトルのセット(おまけ) ActiveSheet.ChartObjects("グラフ 1").Activate ActiveChart.ChartTitle.Select ActiveChart.ChartTitle.Text = "title" 'グラフを選択している状態でGIFT形式でエクスポート myRess = ActiveChart.Export("c:\temp\test.GIF", "GIF", False)