質問編集履歴
1
とりあえず 解決とします
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -501,3 +501,135 @@
|
|
|
501
501
|
End Function
|
|
502
502
|
|
|
503
503
|
```
|
|
504
|
+
|
|
505
|
+
|
|
506
|
+
|
|
507
|
+
(目的を ほぼ 満たしたため) ttyp03さんの コードに 追記して 解決とします
|
|
508
|
+
|
|
509
|
+
回答いただいた皆様 ありがとうございました
|
|
510
|
+
|
|
511
|
+
※ 加筆したコードが 正解かどうかは 別ですが
|
|
512
|
+
|
|
513
|
+
|
|
514
|
+
|
|
515
|
+
```VBA
|
|
516
|
+
|
|
517
|
+
Private Function 相対URL変換2(w_Base_URL As String, w_Link As String)
|
|
518
|
+
|
|
519
|
+
Dim bcols() As String
|
|
520
|
+
|
|
521
|
+
Dim lcols() As String
|
|
522
|
+
|
|
523
|
+
Dim bcol As Variant
|
|
524
|
+
|
|
525
|
+
Dim lcol As Variant
|
|
526
|
+
|
|
527
|
+
|
|
528
|
+
|
|
529
|
+
If Left(w_Link, 1) = "#" Then
|
|
530
|
+
|
|
531
|
+
相対URL変換2 = ""
|
|
532
|
+
|
|
533
|
+
Exit Function
|
|
534
|
+
|
|
535
|
+
End If
|
|
536
|
+
|
|
537
|
+
|
|
538
|
+
|
|
539
|
+
If InStr(w_Link, "http") = 1 Then
|
|
540
|
+
|
|
541
|
+
相対URL変換2 = w_Link
|
|
542
|
+
|
|
543
|
+
Exit Function
|
|
544
|
+
|
|
545
|
+
End If
|
|
546
|
+
|
|
547
|
+
|
|
548
|
+
|
|
549
|
+
If Right(w_Base_URL, 1) = "/" Then
|
|
550
|
+
|
|
551
|
+
w_Base_URL = Left(w_Base_URL, Len(w_Base_URL) - 1)
|
|
552
|
+
|
|
553
|
+
' MsgBox (w_Base_URL)
|
|
554
|
+
|
|
555
|
+
End If
|
|
556
|
+
|
|
557
|
+
|
|
558
|
+
|
|
559
|
+
If InStr(w_Base_URL, "/#") > 0 Then
|
|
560
|
+
|
|
561
|
+
w_Base_URL = Left(w_Base_URL, InStr(w_Base_URL, "/#") - 1)
|
|
562
|
+
|
|
563
|
+
End If
|
|
564
|
+
|
|
565
|
+
|
|
566
|
+
|
|
567
|
+
If Right(w_Base_URL, 4) = ".htm" Then
|
|
568
|
+
|
|
569
|
+
w_Base_URL = Left(w_Base_URL, InStrRev(w_Base_URL, "/") - 1)
|
|
570
|
+
|
|
571
|
+
End If
|
|
572
|
+
|
|
573
|
+
|
|
574
|
+
|
|
575
|
+
If Right(w_Base_URL, 5) = ".html" Then
|
|
576
|
+
|
|
577
|
+
w_Base_URL = Left(w_Base_URL, InStrRev(w_Base_URL, "/") - 1)
|
|
578
|
+
|
|
579
|
+
End If
|
|
580
|
+
|
|
581
|
+
|
|
582
|
+
|
|
583
|
+
bcols = Split(w_Base_URL, "/")
|
|
584
|
+
|
|
585
|
+
lcols = Split(w_Link, "/")
|
|
586
|
+
|
|
587
|
+
|
|
588
|
+
|
|
589
|
+
If Left(w_Link, 1) = "/" Then
|
|
590
|
+
|
|
591
|
+
ReDim Preserve bcols(3)
|
|
592
|
+
|
|
593
|
+
bcols(3) = Mid(w_Link, 2)
|
|
594
|
+
|
|
595
|
+
Else
|
|
596
|
+
|
|
597
|
+
For Each lcol In lcols
|
|
598
|
+
|
|
599
|
+
Select Case lcol
|
|
600
|
+
|
|
601
|
+
Case "."
|
|
602
|
+
|
|
603
|
+
Case ".."
|
|
604
|
+
|
|
605
|
+
ReDim Preserve bcols(UBound(bcols) - 1)
|
|
606
|
+
|
|
607
|
+
Case Else
|
|
608
|
+
|
|
609
|
+
ReDim Preserve bcols(UBound(bcols) + 1)
|
|
610
|
+
|
|
611
|
+
bcols(UBound(bcols)) = lcol
|
|
612
|
+
|
|
613
|
+
End Select
|
|
614
|
+
|
|
615
|
+
Next
|
|
616
|
+
|
|
617
|
+
End If
|
|
618
|
+
|
|
619
|
+
|
|
620
|
+
|
|
621
|
+
相対URL変換2 = Join(bcols, "/")
|
|
622
|
+
|
|
623
|
+
|
|
624
|
+
|
|
625
|
+
If InStr(相対URL変換2, "#") > 0 Then
|
|
626
|
+
|
|
627
|
+
相対URL変換2 = ""
|
|
628
|
+
|
|
629
|
+
End If
|
|
630
|
+
|
|
631
|
+
|
|
632
|
+
|
|
633
|
+
End Function
|
|
634
|
+
|
|
635
|
+
```
|