メールの本文を1行づつよみとってEXCELへ書き出そうと思っています。
Sub getMail1()
Dim myOl As New Outlook.Application
Dim dFolder As MAPIFolder
Dim myItem As MailItem
Dim delItem As MailItem
Dim myRecipient As Recipient
Dim i As Long, j As Long
Const mAddress = 0, mTel = 1, mName = 2, mAge = 3
Set dFolder = myOl.GetNamespace _
("MAPI").Folders("個人用フォルダ").Folders("単発")
i = 1
On Error Resume Next
For Each myItem In dFolder.Items
i = i + 1
Set delItem = myItem.Reply
For Each myRecipient In delItem.Recipients
If InStr(1, myRecipient.Address, "@", vbBinaryCompare) _
<> 0 Then
Exit For
End If
Next
delItem.Delete
With ActiveSheet
myBody = Split(myItem.Body, vbCrLf)
.Cells(i, 1).Value = myRecipient.Address
.Cells(i, 2) = myItem.SenderName
.Cells(i, 3) = myItem.Subject
.Cells(i, 4) = myItem.ReceivedTime
For j = 0 To UBound(myBody)
i = i + 1
On Error Resume Next
.Cells(i, 1) = myBody(j)
.Cells(i, 1).MergeCells = True
Next
End With
i = i + 1
Next
Set myOl = Nothing
End Sub
このようなコードを書いて書き出すことは出来たのですが配列が縦になってしまいます。
横に配列したいのですが教えてください。
伊藤太郎
東京都
03-3123-4567を
伊藤太郎 東京都 03-3123-4567
としたいです。
よろしくお願いします。
コンボボックスでACCEESSのテーブルのデータを検索できるようにしたいのですが・・・。
一度プログラムを書いてみたのですが
うまく動かず画面の表示に失敗しましたとエラー表示が出ます。どこがどう悪いのか教えてください。お願いします。
Dim intloop As Integer
On Error GoTo ERR_ROUTIN
IERR_HANDLER.Push "fncSetDisplay"
For intloop = 0 To UBound(PUSRCUST)
If PwrkCUSTCD = PUSRCUST(intloop).intCustCD Then
Exit For
End If
Next
If intloop >= UBound(PUSRCUST) Or UBound(PUSRCUST) = 0 Then
cmbCUSTCD = ""
Else
cmbCUSTCD.ListIndex = intloop '
End If
fncSetDisplay = True
END_ROUTIN:
IERR_HANDLER.Pop
Exit Function
ERR_ROUTIN:
MsgBox "画面の表示に失敗しました", vbCritical, Me.Caption
fncSetDisplay = False
IERR_HANDLER.HandleError
GoTo END_ROUTIN
End Function
おせわになっております。
VBでデータベースを作っているのですが、
コンボボックスでの検索での絞込みがうまくいきません。
例えば、コンボボックス１で選ばれたファールドにより
絞込みが行われ、コンボボックス２で表示するレコードは
コンボボックス１で選択されたレコードに該当するものしか表示しないようにするというとです。
どこかおかしい個所はありますでしょうか？？
よろしくお願い致します。
Private Sub dbc1_Click(Area As Integer)
'１つめのコンボボックス
Dim criteria As String ' 検索条件
If dbc1.Text = "" Then
Exit Sub
End If
criteria = "県名 = '" & dbc1.SelText & "'"
rs.MoveFirst
rs.Find criteria, , adSearchForward
dbc2.SetFocus
`dbc2にフォーカスを移す
End Sub
Private Sub dbc2_Click(Area As Integer)
’2つ目のコンボボックス
Dim mySQL As String
mySQL = "SELECT 市名 FROM 地名" _
& "where 県名 = '" & dbc1.SelText & "'"
’コンボボックス１で選択されたものを抽出条件とする。
Set rs = New ADODB.Recordset
rs.Open mySQL, cn, adOpenStatic
Set Dbc2.DataSource = rs
End Sub
ＣＳＶファイルを読み込んでAccessへ格納したいのですがどうしたら良いのでしょうか？
ここまではできたのですが・・・・。
Private Sub Command1_Click()
CommonDialog1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CommonDialog1.ShowOpen
End Sub
環境
Windows2000
VB6
DAOで同じデータベースを開くためのやり方がわかりません。
下記のようにマスタのキーを使用して他のテーブルの
内容を更新したいのですが
よろしくお願いします。m(__)m
Dim ws As Workspace
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim STRSQL As String
dim strsql2 as string
Set ws = DBEngine.Workspaces(0)
Set db = ws.Databases(0)
STRSQL = "SELECT KEY FROM マスタ"
Set qd = db.CreateQueryDef("", STRSQL)
Set rs = qd.OpenRecordset()
Do While Not rs.EOF
strsql2 = "Update data from マスタ where key = " & rs!key
????
rs.MoveNext
Loop
rs.Close
qd.Close
db.Close
