Office中国论坛/Access中国论坛

标题: 1.代码和2.代码,需要论坛上的朋友帮忙,万分谢谢! [打印本页]

作者: 运行 时间: 2009-10-26 10:16
标题: 1.代码和2.代码,需要论坛上的朋友帮忙,万分谢谢!
您好!

在这个表中我们有
一.1.用户名 2.密码  3.网站名 4.网址  5.原来标题 6.新标题
二. 还包括当前文件夹下的 7.新内容.TXT 等内容
这些都非常好理解!求助如下,
1.我们依次根据B列网址,将贴子的原来的标题,更改成G列对应的新标题
2.将当前文件夹下的  新内容.TXT(或H2:H33) 内容更新至贴子里
3.完成编辑状态!
4.依次将B列的网址,依上1-3步骤完成
例:1.打开B2网址编辑贴子,将标题更新对应G列的标题(这里是G2单元格)内容成为新标题
2.将贴子内容CTRL+A  按Delete 然后将  新内容.TXT(或H2:H33) 内容复制更新至贴子里
3.按  编辑完成B2网址的更新工作
论坛朋友详见求助附档.....
以下是1.代码和2.代码,不过需要论坛上的朋友帮忙,因为中途有提示,万分谢谢!
==========================================
1.自己登录论坛  2.自动更新标题和内容。northwolves狼版主提供,谢谢！
==========================================
1.自己登录论坛
网上摘的，不知该如何改！
Sub 自己登录论坛()
Dim IE As Object, timeie As Date
Dim sUser As String, sPwd As String
'sUser = "Excel教程" 'InputBox("请键入用户名：")
  ' sPwd = "123456" 'InputBox("请键入登录密码：")
On Error Resume Next
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.Navigate "http://www.officefans.net/cdb/logging.php?action=login"
timeie = DateAdd("s", 60, Now())  '最久等待60秒
Do While IE.Busy And Not IE.ReadyState = READYSTATE_COMPLETE
   DoEvents
   If timeie < Now() Then
         MsgBox "无法连接网站,请重新执行"
         IE.Quit
         Exit Sub
   End If
Loop
IE.Document.all.UserName.Value = "运行"
IE.Document.all.Password.Value = "123456"
IE.Document.all.submit.Click '

'最后，自动输入用户名和密码后，没有“提交”这应该怎么增加呢,    谢谢!

End Sub

==============================================
2.自动更新标题和内容。northwolves狼版主提供,谢谢！
==============================================
'以下是northwolves狼版主帮忙写给＂小羊羊＂的代码!
运行中断提示如下：还是非常感谢northwolves
'显示"运行时错误"91"
'对象变量或With块变量未设置
Private Sub 更新标题及内容_Click()
Dim s
With CreateObject("InternetExplorer.Application")
.Visible = True
.navigate [b2] '网址
Do Until .Readystate = 4
DoEvents
Loop
Debug.Print Split(.Document.body.innerhtml, "编辑")(0)
s = Split(Split(.Document.body.innerhtml, "编辑")(0), """")
.navigate "http://www.officefans.net/" & Replace(s(UBound(s) - 1), "amp;", "")
Do Until .Readystate = 4
DoEvents
Loop
.Document.forms(0).all("title").Value = [g2].Value  '新标题
.Document.forms(0).all("message").innertext = Join([Transpose(h2:h19)], vbCrLf)  '新内容
.Document.forms(0).all("editsubmit").Click
End With
'MsgBox "Ok"
End Sub

作者: 运行 时间: 2009-10-26 17:02
有没有朋友帮忙看看！谢谢！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)