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

运行

有没有朋友帮忙看看！谢谢！