質問編集履歴
1
とりあえず 解決とします
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -249,4 +249,70 @@
|
|
|
249
249
|
URLEncode = Join(result, "")
|
|
250
250
|
End If
|
|
251
251
|
End Function
|
|
252
|
+
```
|
|
253
|
+
|
|
254
|
+
(目的を ほぼ 満たしたため) ttyp03さんの コードに 追記して 解決とします
|
|
255
|
+
回答いただいた皆様 ありがとうございました
|
|
256
|
+
※ 加筆したコードが 正解かどうかは 別ですが
|
|
257
|
+
|
|
258
|
+
```VBA
|
|
259
|
+
Private Function 相対URL変換2(w_Base_URL As String, w_Link As String)
|
|
260
|
+
Dim bcols() As String
|
|
261
|
+
Dim lcols() As String
|
|
262
|
+
Dim bcol As Variant
|
|
263
|
+
Dim lcol As Variant
|
|
264
|
+
|
|
265
|
+
If Left(w_Link, 1) = "#" Then
|
|
266
|
+
相対URL変換2 = ""
|
|
267
|
+
Exit Function
|
|
268
|
+
End If
|
|
269
|
+
|
|
270
|
+
If InStr(w_Link, "http") = 1 Then
|
|
271
|
+
相対URL変換2 = w_Link
|
|
272
|
+
Exit Function
|
|
273
|
+
End If
|
|
274
|
+
|
|
275
|
+
If Right(w_Base_URL, 1) = "/" Then
|
|
276
|
+
w_Base_URL = Left(w_Base_URL, Len(w_Base_URL) - 1)
|
|
277
|
+
' MsgBox (w_Base_URL)
|
|
278
|
+
End If
|
|
279
|
+
|
|
280
|
+
If InStr(w_Base_URL, "/#") > 0 Then
|
|
281
|
+
w_Base_URL = Left(w_Base_URL, InStr(w_Base_URL, "/#") - 1)
|
|
282
|
+
End If
|
|
283
|
+
|
|
284
|
+
If Right(w_Base_URL, 4) = ".htm" Then
|
|
285
|
+
w_Base_URL = Left(w_Base_URL, InStrRev(w_Base_URL, "/") - 1)
|
|
286
|
+
End If
|
|
287
|
+
|
|
288
|
+
If Right(w_Base_URL, 5) = ".html" Then
|
|
289
|
+
w_Base_URL = Left(w_Base_URL, InStrRev(w_Base_URL, "/") - 1)
|
|
290
|
+
End If
|
|
291
|
+
|
|
292
|
+
bcols = Split(w_Base_URL, "/")
|
|
293
|
+
lcols = Split(w_Link, "/")
|
|
294
|
+
|
|
295
|
+
If Left(w_Link, 1) = "/" Then
|
|
296
|
+
ReDim Preserve bcols(3)
|
|
297
|
+
bcols(3) = Mid(w_Link, 2)
|
|
298
|
+
Else
|
|
299
|
+
For Each lcol In lcols
|
|
300
|
+
Select Case lcol
|
|
301
|
+
Case "."
|
|
302
|
+
Case ".."
|
|
303
|
+
ReDim Preserve bcols(UBound(bcols) - 1)
|
|
304
|
+
Case Else
|
|
305
|
+
ReDim Preserve bcols(UBound(bcols) + 1)
|
|
306
|
+
bcols(UBound(bcols)) = lcol
|
|
307
|
+
End Select
|
|
308
|
+
Next
|
|
309
|
+
End If
|
|
310
|
+
|
|
311
|
+
相対URL変換2 = Join(bcols, "/")
|
|
312
|
+
|
|
313
|
+
If InStr(相対URL変換2, "#") > 0 Then
|
|
314
|
+
相対URL変換2 = ""
|
|
315
|
+
End If
|
|
316
|
+
|
|
317
|
+
End Function
|
|
252
318
|
```
|