PowerPoint VBA“找不到文件”（错误53），但文件确实存在

问题描述 投票：0回答：1

我正在使用启用VBA的PowerPoint，该PowerPoint从rssweather.com获取提要，并对其进行解析以查找当前天气（截至当前状态，它尚未这样做。）到目前为止，我使用getPageText来将提要作为XML文件获取，然后开始解析（有时，解析时会出现索引错误。我目前正在调查此问题，但与我发布的问题无关）。我想要一个包含供稿的文本文档，以与传入的供稿进行比较并检查格式更改（因为这会使分析器无法正常工作）。我的问题是，当我尝试获取文件的内容时，VBA找不到它（它与PowerPoint位于同一目录中。我已经做过一些阅读，这是我尝试过的其他人遇到的问题与-将文件移动到其他位置，然后尝试新的文件路径-检查隐藏的或只读的服装-检查文件路径中的拼写错误（我尝试从文件资源管理器剪切和粘贴）-检查文件路径中的转义/特殊字符-确保文件不在网络驱动器上（我正在RDP中进入PC以在Powerpoint上工作，但是文件存储在其桌面上）-尝试他人的工作代码-检查访问权限-在文件名前添加反斜杠（返回工作目录的函数对您而言不这样做）

这是获取提要的代码：

Function getPageText(url As String) 'this function is used to get webpage data. in our Macro, it gets the current weather from www.rssweather.com
    Dim waited As Integer 'used to see if webpage is responding
    Dim temp 'this variable is involved when seeing i the webpage is done downloading

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url
        .send

        'get the text
        On Error GoTo Retry
        getPageText = .responseText 'return as one massive string
    End With

    'attempt to use webpage and catch with error
Retry:
    'bump up waited for entering
    waited = waited + 1

    'check for timeout
    If waited = 30 Then GoTo No_connection 'if no response after 30 seconds, display error

    'no timeout so try again
    On Error GoTo Retry
    Counters.Wait (1)
    temp = getPageText

    Exit Function

No_connection:
    MsgBox "Error: RSS feed timed out. Please check the connection or contact your local VBA expert."

    'kill the timers
    Call KillOnTime

    'set the function to nothing so WeatherUpdate will recogize it as an error in the rss feed format checking
    getPageText = ""

End Function

这是我的代码，应该用来比较和解析提要：

Sub WeatherUpdate()

'setup variables to represent the textboxes actual fields for ease of use
Dim curr As String
Dim fore As String
Dim img As String

curr = ""
fore = ""
img = ""

'get rss feed. getPageText returns the content in XML code as one massive string
Dim webcontent As String
webcontent = getPageText("http://www.rssweather.com/zipcode/24523/rss.php")

'verify rss feed is still using the same format CHECK LENGTH TOO
Dim iFile As Integer
Dim examplecontent As String

iFile = FreeFile
Open ActivePresentation.Path & "\Example RSS Feed.txt" For Input As iFile
examplecontent = Input(LOF(iFile), iFile)
Close iFile

'Debug.Print examplecontent
'Debug.Print simil(examplecontent, webcontent)

'start scraping out the XML code and keep the text we want by using XML features
curr = curr & Split(Split(webcontent, "<title>")(2), "F")(0) & "ºF, " & Split(Split(webcontent, "<span class=" & Chr(34) & "sky" & Chr(34) & ">")(1), "<")(0) ' this grabs the text between <title> and </title> to use as current conditions title

img = Split(Split(Split(webcontent, "<img src=" & Chr(34))(1), Chr(34))(0), "fcicons/")(1) 'this complicated splitting grabs the image name out of a webaddress so we know what icon/weather symbol they are trying to use so we can pick the same

webcontent = Right(webcontent, Len(webcontent) - Len(Split(webcontent, "<dd id=" & Chr(34))(0)) - 8) 'this shortens and simplifies the overall webcontent string by cutting out the beginning we took curr and img from

curr = curr & vbCrLf & "Humidity: " & Split(Split(webcontent, ">")(1), "<")(0) 'grab humidity value and pack it nicely into "Humidity: [value]"

curr = curr & vbCrLf & "Windspeed: " & Split(Split(webcontent, ">")(5), "<")(0) 'grab windspeed value

curr = curr & vbCrLf & "Wind Direction: " & Split(Split(webcontent, ">")(9), "(")(0) 'grab winddir value

'curr is now filled with what is needed. cut out the XML crap to skip to the next area
webcontent = Split(webcontent, "</guid>")(1)

'next, all forecast entries follow the same format. we will have to store them in a string array and refer to each area by index
Dim forecontent() As String
forecontent = Split(webcontent, "<item>")

'fill out the forecast for day+1 (index 3)


'start the timer to run again in an hour
'Call StartOnTime

End Sub

这是我的代码供您使用

Option Explicit

Dim weatherImage As Shape 'this variable will hold the location of the weather slide's changing image
Dim weatherCurrent As Shape 'this variable will hold the location of the current weather text on the weather slide
Dim weatherForecast As Shape 'this variable will hold the location of the forecast text on the weather slide

'timer code. runs a sub every x miliseconds. retrieved from https://social.msdn.microsoft.com/forums/en-US/9f6891f2-d0c4-47a6-b63f-48405aae4022/powerpoint-run-macro-on-timer. Thanks for the help user SJOO!
Dim lngTimerID As Long
Dim blnTimer As Boolean

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal _
    lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Sub StartOnTime()
    If blnTimer Then
        lngTimerID = KillTimer(0, lngTimerID)
        If lngTimerID = 0 Then
            MsgBox "Error : Timer Not Stopped"
            Exit Sub
        End If
        blnTimer = False

    Else
        lngTimerID = SetTimer(0, 0, 3600000, AddressOf WeatherUpdate) 'modified from HelloTimer to Weather Update and timer length from 5 seconds (5000) to an hour (3600000)
        If lngTimerID = 0 Then
            MsgBox "Error : Timer Not Generated "
            Exit Sub
        End If
        blnTimer = True

    End If
End Sub

Sub KillOnTime()
    lngTimerID = KillTimer(0, lngTimerID)
    blnTimer = False
End Sub
'end of timer code

Function getPageText(url As String) 'this function is used to get webpage data. in our Macro, it gets the current weather from www.rssweather.com
    Dim waited As Integer 'used to see if webpage is responding
    Dim temp 'this variable is involved when seeing i the webpage is done downloading

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url
        .send

        'get the text
        On Error GoTo Retry
        getPageText = .responseText 'return as one massive string
    End With

    'attempt to use webpage and catch with error
Retry:
    'bump up waited for entering
    waited = waited + 1

    'check for timeout
    If waited = 30 Then GoTo No_connection 'if no response after 30 seconds, display error

    'no timeout so try again
    On Error GoTo Retry
    Counters.Wait (1)
    temp = getPageText

    Exit Function

No_connection:
    MsgBox "Error: RSS feed timed out. Please check the connection or contact your local VBA expert."

    'kill the timers
    Call KillOnTime

    'set the function to nothing so WeatherUpdate will recogize it as an error in the rss feed format checking
    getPageText = ""

End Function

Function charAt(str As String, index As Integer)

charAt = CChar(Mid(str, index, 1))

End Function

Function simil(str1 As String, str2 As String) 'this function returns the percent similar two strings are. this is used to determine if the rss feed has had a format change

'total number of similar characters
Dim total As Long

'str1 should be the shortest, switch them if they are not
If Len(str1) >= Len(str2) Then
Dim temp As String
temp = str1
str1 = str2
str2 = temp

'iterate through the str1 and compare characters
Dim i As Integer

For i = 1 To Len(str1)

If charAt(str1, i) = charAt(str1, i) Then
total = total + 1
End If

Next i

'return percent similar as a percent! aka already multiplied by 100
simil = total / Len(str2)

End Function

Sub weatherFind() 'this sub locates the weather slide and assigns weatherImage and weatherText to their respective location

Dim i As Integer
Dim j As Integer

'2D loop to go through each slide and each image on the slide
For i = 1 To ActivePresentation.Slides.Count
For j = 1 To ActivePresentation.Slides(i).Shapes.Count

If StrComp(ActivePresentation.Slides(i).Shapes(j).Name, "weather_curr") = 0 Then
Set weatherCurrent = ActivePresentation.Slides(i).Shapes(j)
End If

If StrComp(ActivePresentation.Slides(i).Shapes(j).Name, "weather_fore") = 0 Then
Set weatherForecast = ActivePresentation.Slides(i).Shapes(j)
End If

If StrComp(ActivePresentation.Slides(i).Shapes(j).Name, "weather_img") = 0 Then
Set weatherImage = ActivePresentation.Slides(i).Shapes(j)
End If

Next j
Next i

'trigger the weather update now and every hour
Call WeatherUpdate

End Sub

Sub WeatherUpdate()

'setup variables to represent the textboxes actual fields for ease of use
Dim curr As String
Dim fore As String
Dim img As String

curr = ""
fore = ""
img = ""

'get rss feed. getPageText returns the content in XML code as one massive string
Dim webcontent As String
webcontent = getPageText("http://www.rssweather.com/zipcode/24523/rss.php")

'verify rss feed is still using the same format CHECK LENGTH TOO
Dim iFile As Integer
Dim examplecontent As String

iFile = FreeFile
Open ActivePresentation.Path & "\Example RSS Feed.txt" For Input As iFile
examplecontent = Input(LOF(iFile), iFile)
Close iFile

'Debug.Print examplecontent
'Debug.Print simil(examplecontent, webcontent)

'start scraping out the XML code and keep the text we want by using XML features
curr = curr & Split(Split(webcontent, "<title>")(2), "F")(0) & "ºF, " & Split(Split(webcontent, "<span class=" & Chr(34) & "sky" & Chr(34) & ">")(1), "<")(0) ' this grabs the text between <title> and </title> to use as current conditions title

img = Split(Split(Split(webcontent, "<img src=" & Chr(34))(1), Chr(34))(0), "fcicons/")(1) 'this complicated splitting grabs the image name out of a webaddress so we know what icon/weather symbol they are trying to use so we can pick the same

webcontent = Right(webcontent, Len(webcontent) - Len(Split(webcontent, "<dd id=" & Chr(34))(0)) - 8) 'this shortens and simplifies the overall webcontent string by cutting out the beginning we took curr and img from

curr = curr & vbCrLf & "Humidity: " & Split(Split(webcontent, ">")(1), "<")(0) 'grab humidity value and pack it nicely into "Humidity: [value]"

curr = curr & vbCrLf & "Windspeed: " & Split(Split(webcontent, ">")(5), "<")(0) 'grab windspeed value

curr = curr & vbCrLf & "Wind Direction: " & Split(Split(webcontent, ">")(9), "(")(0) 'grab winddir value

'curr is now filled with what is needed. cut out the XML crap to skip to the next area
webcontent = Split(webcontent, "</guid>")(1)

'next, all forecast entries follow the same format. we will have to store them in a string array and refer to each area by index
Dim forecontent() As String
forecontent = Split(webcontent, "<item>")

'fill out the forecast for day+1 (index 3)


'start the timer to run again in an hour
'Call StartOnTime

End Sub

并且这里证明文件确实存在：

playing hide and seek with Example RSS Feed.txt

谢谢您的帮助！ ：）

vba rss powerpoint file-not-found
1个回答
0
投票

[无需详细查看您的代码，也许只是尝试通过vba脚本打开文件。 limited MSDN documentation告诉我们您的文件路径没有将您带到文件。

我将尝试监视此变量，以查看字符串输出是否是正确的路径：

ActivePresentation.Path & "\Example RSS Feed.txt" For Input As iFile

希望有所帮助

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.