削除クエリ実行時(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)