Excel VBA で「型が一致しません」というエラーが発生します。
--------------------------------------------------------------------------------
Dim katacode as String
katacode = "(1001,1002,1005,1010,1015,1020,1030,1035,1036,1040,…(省略)…,1150)"
With ActiveSheet.QueryTables.Add(Connection:= _
pubfncgetConnectString,Destination:=Range("A1"))
.CommandText = Array(_
"SELECT ~
FROM ~
WHERE コード IN katacode
--------------------------------------------------------------------------------
「katacode」の値が、文字列の長さが155までは上手く動くのですが
それ以上に追加すると「型が一致しません」というエラーが発生します。
原因がわかりましたら教えていただけないでしょうか。よろしくお願い致します。
Outlook2007 送信前の宛先確認のマクロを設定したいと考えています。
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo Ex ception
Dim strCC
strCC = vbCrLf
Dim objRec As Recipients
For Each objRec In Item.Recipients
strCC = strCC & objRec.Name & vbCrLf
Next
Dim strMsg As String
strMsg = "件名:" & Item.Subject & vbCrLf & _
_
strCC & vbCrLf & _
_
"上記の宛先に、メールを送信してもよろしいですか?"
If MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End If
On Error GoTo 0
Exit Sub
Exception:
MsgBox CStr(Err.Number) & ":" & Err.Description, vbOkOnly + vbCritical
Cancel = True
Exit Sub
これだけだと、End subが必要ですというポップアップがあがり、付加すると『型が一致しません』というポップアップがあがってしまいます。
どうすれば良いか教えていただけますか?
あと、宛先をグループ登録してる場合、グループ登録している宛先を氏名で表示する方法はありますでしょうか??
エクセルvbaでadoを使って他ファイルの件数を取得することは可能でしょうか?
もともと件数を取得したいファイルは共有フォルダに入っていて、
開くのにすごく時間がかかるのでADOで試みたいのです。
しかしうまくいきません。
当方の環境は
Win7、エクセル2010です。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_090.html
を参考にしたのですが、
Const cnsProvider = "Microsoft.Jet.OLEDB.4.0"
Const cnsExtProp = "Extended Properties"
Const cnsExcel = "Excel 8.0"
Const cnsDBName = "D:\Book1.xlsx" 'ローカルでテスト
Sub ADO_WS_TEST1()
Dim dbCon As ADODB.Connection
Dim dbRes As ADODB.Recordset
Dim GYO As Long, COL As Long
Dim strSQL As String
' Connection生成
Set dbCon = New ADODB.Connection
With dbCon
.Provider = cnsProvider
.Properties(cnsExtProp) = cnsExcel
.Open cnsDBName
End With
の
.Open cnsDBNameの部分で、
実行時エラー-2147467259
外部テーブルのフォーマットが正しくありません。
となります。
Excel 8.0が原因なのでしょうか?
オフィス2010でもExcel 8.0でいいのでしょうか?
ココがうまく通ったら、
"SELECT * FROM [Sheet1$]"の部分をCOUNTにして
件数が取得できるかなー
と思うのです。
リンク先を読むと、adoでやってもあまり早くはならなそうですが一応やってみたいのです。
よろしくお願いします。
Excel VBAで単一ブックで複数のウィンドウを開いている時、その片方を閉じるイベントは
Sub Workbook_WindowDeactivate(ByVal Wn As Window)
End Sub
で、良いのでしょうか。
単一ブックで複数のウィンドウを開いている時は、エクセル本体の右上×をクリックすると1つずつしかウィンドウが閉じず、面倒なので、1つ閉じたらエクセル自体(若しくはブック一つ)が閉じるようなプロシージャを組みたいのです。
よろしくお願いします。
VBA初心者です.よろしくお願いいたします.
用語の読みを自動で振るシートを作成しているのですが,Do Loop部分が一行ずつの入力となっていて,時間がかかっています.
これを配列等の方法を用いて高速化したいと思って,試行錯誤したのですが,うまくいきません.
何卒お教えくださいますようお願いいたします.
用語の読みを生成する手順ですが,
1.シート1に用語をペーストする
2.ペーストされた用語をシート2にある用語のDB(用語と読みが入力されています.重複レコードなし)にコピー
3.コピーされたシート2をピボットにして個数が2以上あった場合,その用語と読みを返します.
4.Do Loopで最初にヒットした用語に戻るまでループ
となっています.
3までの手順に修正の必要はないのですが,4の手順でかなり時間をロスしております.
ここを配列等の方法で一度に書き込むことができればと思っています.
Sub test()
i = 8
L_Row04 = 180188
Dim S1 As Worksheet '読みを振る用語をペーストするシート
Dim S2 As Worksheet '読み用の用語のDB
Dim S3 As Worksheet 'ピボット
Dim L_Row01 As Long 'S1にペーストされた用語の最下行
Dim L_Row02 As Long 'S1の用語をs2にペーストしたときの最下行
Dim L_Row03 As Long 'ピボットの用語の最下行
Dim Rng01 As Range 'S1にペーストされた用語の範囲
Dim Rng02 As Range 'S2にペーストされた用語の範囲
Dim Rng03 As Range 'ピボットの範囲
Dim Str01 As Variant 'ピボットで2以上あったときの用語
Dim Str02 As Variant 'ピボットで2以上あったときの読み
Dim firstcell As Range
Dim Foundcell01 As Range
Set S1 = Worksheets(1)
Set S2 = Worksheets(2)
Set S3 = Worksheets(3)
S1.Activate
L_Row01 = S1.Cells(Rows.Count, 2).End(xlUp).Row
L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row
Set Rng01 = S1.Range(Cells(i, 2), Cells(L_Row01, 2))
Rng01.Copy Destination:=S2.Cells(L_Row02 + 1, 2 + 1)
S3.PivotTables("ピボットテーブル2").RefreshTable
S2.Activate
L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row
Set Rng02 = S2.Range(Cells(L_Row04, 3), Cells(L_Row02, 3))
Rng02.Delete
S3.Activate
L_Row03 = S3.Cells(Rows.Count, 2).End(xlUp).Row
Set Rng03 = S3.Range(Cells(4, 2), Cells(L_Row03, 2))
For Each a In Rng03
If a >= 2 And a.Offset(0, -1).Value <> "(空白)" And a.Offset(1, -1).Value <> "(空白)" Then
Str01 = a.Offset(0, -1)
Str02 = a.Offset(1, -1)
S1.Activate
Set Foundcell01 = Rng01.Find(What:=Str01, searchorder:=xlByRows, LookIn:=xlValues, lookat:=xlWhole)
Do
Selection.Offset(0, 1).Value = Str02
Selection.Offset(0, 2).Value = "●"
Loop Until ActiveCell.Address = firstcell.Address
End If
End If
Next
End Sub
VBA初心者です.よろしくお願いいたします.
用語の読みを自動で振るシートを作成しているのですが,Do Loop部分が一行ずつの入力となっていて,時間がかかっています.
これを配列等の方法を用いて高速化したいと思って,試行錯誤したのですが,うまくいきません.
何卒お教えくださいますようお願いいたします.
用語の読みを生成する手順ですが,
1.シート1に用語をペーストする
2.ペーストされた用語をシート2にある用語のDB(用語と読みが入力されています.重複レコードなし)にコピー
3.コピーされたシート2をピボットにして個数が2以上あった場合,その用語と読みを返します.
4.Do Loopで最初にヒットした用語に戻るまでループ
となっています.
3までの手順に修正の必要はないのですが,4の手順でかなり時間をロスしております.
ここを配列等の方法で一度に書き込むことができればと思っています.
Sub test()
i = 8
L_Row04 = 180188
Dim S1 As Worksheet '読みを振る用語をペーストするシート
Dim S2 As Worksheet '読み用の用語のDB
Dim S3 As Worksheet 'ピボット
Dim L_Row01 As Long 'S1にペーストされた用語の最下行
Dim L_Row02 As Long 'S1の用語をs2にペーストしたときの最下行
Dim L_Row03 As Long 'ピボットの用語の最下行
Dim Rng01 As Range 'S1にペーストされた用語の範囲
Dim Rng02 As Range 'S2にペーストされた用語の範囲
Dim Rng03 As Range 'ピボットの範囲
Dim Str01 As Variant 'ピボットで2以上あったときの用語
Dim Str02 As Variant 'ピボットで2以上あったときの読み
Dim firstcell As Range
Dim Foundcell01 As Range
Set S1 = Worksheets(1)
Set S2 = Worksheets(2)
Set S3 = Worksheets(3)
S1.Activate
L_Row01 = S1.Cells(Rows.Count, 2).End(xlUp).Row
L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row
Set Rng01 = S1.Range(Cells(i, 2), Cells(L_Row01, 2))
Rng01.Copy Destination:=S2.Cells(L_Row02 + 1, 2 + 1)
S3.PivotTables("ピボットテーブル2").RefreshTable
S2.Activate
L_Row02 = S2.Cells(Rows.Count, 3).End(xlUp).Row
Set Rng02 = S2.Range(Cells(L_Row04, 3), Cells(L_Row02, 3))
Rng02.Delete
S3.Activate
L_Row03 = S3.Cells(Rows.Count, 2).End(xlUp).Row
Set Rng03 = S3.Range(Cells(4, 2), Cells(L_Row03, 2))
For Each a In Rng03
If a >= 2 And a.Offset(0, -1).Value <> "(空白)" And a.Offset(1, -1).Value <> "(空白)" Then
Str01 = a.Offset(0, -1)
Str02 = a.Offset(1, -1)
S1.Activate
Set Foundcell01 = Rng01.Find(What:=Str01, searchorder:=xlByRows, LookIn:=xlValues, lookat:=xlWhole)
Do
Selection.Offset(0, 1).Value = Str02
Selection.Offset(0, 2).Value = "●"
Loop Until ActiveCell.Address = firstcell.Address
End If
End If
Next
End Sub