現在、WshShellオブジェクトのCreateShortcutメソッドを使って
下記のように作成しています。

Set objShortcut = objWshShell.CreateShortcut("lnkファイルフルパス")
With objShortcut
    .TargetPath = "実ファイルフルパス"
    .Save 
End With

lnkファイルフルパスに２６０バイトより長いパスを指定すると
エラーが発生してしまいます。

Windowsには２５６文字より長いパスは扱えないという制限があるようですが、
問題が発生するパスは２５６文字よりは短いです。
※Windowsは文字数での制限ですが、
　CreateShortcutの引数はバイト数で制限がかかっているようで、
　日本語（２バイト文字）が含まれていると、
　２５６文字制限を満たしていても、２６０バイト制限はすぐにオーバーしてしまいます。

２６０バイトより長い（ただし２５６文字よりは短い）パスについて、
ショートカットファイルを作成する方法はありませんでしょうか？

よろしくお願いします。

一旦制限内のパスで作成しておき、移動するという手もありそうです。

Sub 一例()
    Dim s As String, lnk As String
    Dim sPath As String, fName As String
    
    s = String(100, "あ") & "\"
    With CreateObject("WScript.Shell")
        sPath = .SpecialFolders("Desktop")
        ChDir sPath
        lnk = "あああああああ.lnk"
        Set objshortcut = .CreateShortcut(lnk)
        With objshortcut
            .TargetPath = Application.Path
            .Save
            fName = .FullName
            MkDir s '合計200バイト以上
            ChDir s
            MkDir s '合計400バイト以上
            ChDir s
            With CreateObject("Scripting.FileSystemObject")
                .getfile(fName).Move ".\"
            End With
        End With
    End With
    ChDir sPath
End Sub

「長いパス名」から「短いパス名」を取得するにはUnicode系のAPI関数を呼び出し、パスの先頭に "\\?\" を付与します。
h ttps://learn.microsoft.com/ja-jp/windows/win32/api/fileapi/nf-fileapi-getshortpathnamew
又、シンボリックリンクを使えば、ショートカット同等の事ができます。
「Unicode系のAPIて何」というレベルなら、諦めてください。

Private Declare Function CreateDirectoryW Lib "kernel32.dll" ( _
    ByVal lpPathName As LongPtr, _
    ByVal lpSecurityAttributes As LongPtr) As Long
Private Declare Function GetShortPathNameW Lib "kernel32" ( _
    ByVal LongPath As LongPtr, _
    ByVal ShortPath As LongPtr, _
    ByVal cchBuffer As Long) As Long
Function ShortPathNameW$(ByVal LongPath$)
    Dim ret&, strBuffer$
    strBuffer = String(260, vbNullChar)
    ret = GetShortPathNameW(StrPtr("\\?\" & LongPath), StrPtr(strBuffer), Len(strBuffer))
    If ret = 0 Then Exit Function
    ShortPathNameW = Mid$(strBuffer, 5, ret - 4)
End Function
Sub 長い名前のショートカット作成()
    Dim LongPath$, ShortPath$, TargetPath$, objShortcut As Object, i&
    LongPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    TargetPath = LongPath
    For i = 1 To 10
        LongPath = LongPath & "\０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９"
        Call CreateDirectoryW(StrPtr("\\?\" & LongPath), 0)
    Next
    ShortPath = ShortPathNameW(LongPath) & "\ショートカット.lnk"
    If ShortPath <> "" Then
        Set objShortcut = CreateObject("WScript.Shell").CreateShortcut(ShortPath)
        With objShortcut
            .TargetPath = TargetPath
            .Save
        End With
    End If
End Sub


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

みなさん、ありがとうございます。

まる2021さんの方法を実行してみたところ、
ショートカットファイルが問題なく作成できていそうです。
ただデバッグ実行すると、不可解な動作をします。

「長い名前のショートカット作成」関数内に
キャレット（キーカーソル）を当てて、F8キーを押すと、
１行ずつステップ実行できますが、
（F8キーを押すたびに黄色い行が１行ずつ進む）

Set objShortcut = CreateObject("WScript.Shell").CreateShortcut(ShortPath)
の行まで進んで、F8キーを押すと、
With objShortcut
の行に行かずに、終了してしまいます。
ただ、「ショートカット.lnk」は作成されています。

----------

kazuoさんの
＞一旦制限内のパスで作成しておき、移動する
がシンプルで無難かな。。。

一旦解決とさせていただきます。

＃まだ時々確認しますので、
＃上記不可解な動作が解消（原因が分かる）ようであれば、
＃まる2021さんの方法を使いたいと思います。

よろしくお願いします。

ちょと、恥ずかしいミスがあったので修正。
↑だと最後のIf文が、毎回通ってしまうので、以下にして下さい。
デバッグの件は、ちょっと、わからないです。
こちらでは普通に次の行に移行します。

Sub 長い名前のショートカット作成()
    Dim LongPath$, ShortPath$, TargetPath$, objShortcut As Object, i&
    LongPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    TargetPath = LongPath
    For i = 1 To 10
        LongPath = LongPath & "\０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９０１２３４５６７８９"
        Call CreateDirectoryW(StrPtr("\\?\" & LongPath), 0)
    Next
    ShortPath = ShortPathNameW(LongPath)
    If ShortPath <> "" Then
        Set objShortcut = CreateObject("WScript.Shell").CreateShortcut(ShortPath & "\ショートカット.lnk")
        With objShortcut
            .TargetPath = TargetPath
            .Save
        End With
    End If
End Sub


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

LongPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
で
LongPath
に
C:\Users\xxxx\Desktop
がセットされた状態で実行すると
ShortPath = ShortPathNameW(LongPath)
で
ShortPath
に
C:\Users\xxxxx\Desktop\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1\０１２~1
がセットされますが


LongPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
を
LongPath = "D:\xxxxx\●●●"
に書き換えて
LongPathに
D:\xxxxx\●●●
がセットされた状態で実行すると
ShortPath = ShortPathNameW(LongPath)
で
ShortPath
には
↑のようにショートパスにならずに、
ロングパスのままがセットされてしまいます。

-------------

F8キーで１行ずつ処理を進めることはできませんね。

ただ、
With objShortcut
の行にF9キーでブレイク（茶色）させると、そこで処理が一時中断するので、

Set objShortcut = CreateObject("WScript.Shell").CreateShortcut(ShortPath & "\ショートカット.lnk")
の行でブレイク（黄色）されている状態でF8キーを押すと、
次の行に行くのではなく、ステップアウトしてしまっているようです。