フォルダ | nujonoa_blog https://nujonoa.com 人生に役立つデータ集 Tue, 26 Mar 2024 01:42:12 +0000 ja hourly 1 https://wordpress.org/?v=6.8.3 https://nujonoa.com/wp-content/uploads/2019/04/cropped-DSC00976-e1554456145409-32x32.jpg フォルダ | nujonoa_blog https://nujonoa.com 32 32 gasでセルの一覧からファイル一覧を作成する方法 https://nujonoa.com/how-to-create-a-file-list-from-a-list-of-cells-with-gas/ https://nujonoa.com/how-to-create-a-file-list-from-a-list-of-cells-with-gas/#respond Tue, 26 Mar 2024 01:42:09 +0000 https://nujonoa.com/?p=24169 gasでセルの一覧からファイル一覧を作成する方法

c列の名前一覧からファイルを作り、特定のフォルダに保存。
d列にそのリンクを追加するプログラムです。

適宜シート名、フォルダID、列を変更して使用ください。

function createSpreadsheetFromColumnC() {
  var ss = SpreadsheetApp.getActiveSpreadsheet();
  var sheet = ss.getSheetByName('Sheet1'); // シート名を適宜変更してください
  var folder = DriveApp.getFolderById('FolderID'); // フォルダIDを適宜変更してください

  var range = sheet.getRange('C:C'); // C列の範囲を取得
  var values = range.getValues(); // C列の値を取得

  for (var i = 0; i < values.length; i++) {
    var fileName = values[i][0];
    if (fileName !== '') { // ファイル名が空でない場合
      var newSpreadsheet = SpreadsheetApp.create(fileName); // ファイル名で新しいスプレッドシートを作成
      var fileId = newSpreadsheet.getId(); // 新しいスプレッドシートのIDを取得

      // 新しいスプレッドシートの親フォルダを変更して移動
      var file = DriveApp.getFileById(fileId); // 新しいスプレッドシートを取得
      var newFile = file.moveTo(folder); // 新しいスプレッドシートを指定のフォルダに移動
      
      // スプレッドシートのリンクを取得してD列に書き込む
      var spreadsheetLink = SpreadsheetApp.openById(newFile.getId()).getUrl();
      sheet.getRange('D' + (i + 1)).setValue(spreadsheetLink);
    }
  }
}
]]> https://nujonoa.com/how-to-create-a-file-list-from-a-list-of-cells-with-gas/feed/ 0 【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法 https://nujonoa.com/create-and-save-serial-numbers/ https://nujonoa.com/create-and-save-serial-numbers/#respond Sun, 31 Jan 2021 01:15:16 +0000 http://nujonoa.com/?p=8705 VBAでSaveAsを使う際に、上書き保存するとそのままエクセルが落ちる現象が散見されました。

そこで、今回は、保存先フォルダに同一の名前が含まれるファイルがあった場合に、
連番を付けて登録するプログラムを作成しました。

【VBA】SaveAsでファイルに連番を追加し重複を防ぐ方法

SaveAsでファイルを保存する際に、
連番を追加し重複を防いで保存するプログラムを下記に示します。
※ダブルクリックでコピーできます。

Sub ファイルに連番を付けて保存()

Application.ScreenUpdating = False

'保存先フォルダを選択*開始**************************************
  MsgBox "保存先フォルダを選択"
  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Users\"
   If .Show = 0 Then
     MsgBox "キャンセルボタンをクリックしました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With
'保存先フォルダを選択*終了**************************************

'保存名を入力*開始***************************************************
FileName = Application.InputBox(Prompt:="名前を入力してください。" & vbLf & vbLf, Type:=2, _
           Default:=ActiveSheet.Name & "_" & Year(Now) & Month(Now) & Day(Now))
   If FileName = False Then
     MsgBox "キャンセルボタンをクリックしました。"
     Exit Sub
   End If
'保存名を入力*終了***************************************************
   
'名前のダブり確認*開始***************************************************
        fn = "*" + FileName + "*"
        fnd = Dir(folderPath + "\" + fn, vbNormal)
        I = 0
        'ファイルがない場合
        If (fnd = "") Then
            GoTo CONTINUE1
        'ファイルがあった場合
        Else
        Do While fnd <> ""
           fnd = Dir '次のファイル
           I = I + 1
        Loop
        End If
        FileName = FileName & "(" & I & ")"

CONTINUE1:

'名前のダブり確認*終了***************************************************

FName = folderPath & "\" & FileName

'ファイルの保存***************************************************
    Worksheets.copy
    ActiveWorkbook.SaveAs _
    FileName:=FName, _
    FileFormat:=xlOpenXMLWorkbook
　'ファイルを閉じる
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

'ファイルの保存終了***************************************************


Application.ScreenUpdating = True

 
End Sub

プログラムの説明

プログラムの肝は、この部分になります。
Dir(ファイルパス)関数で、ファイルの存在を確認し、
もしファイルがあった場合、連番の数字を繰り上げていく形になります。

'名前のダブり確認*開始***************************************************
        fn = "*" + FileName + "*"
        fnd = Dir(folderPath + "\" + fn, vbNormal)
        I = 0
        'ファイルがない場合
        If (fnd = "") Then
            GoTo CONTINUE1
        'ファイルがあった場合
        Else
        Do While fnd <> ""
           fnd = Dir '次のファイル
           I = I + 1
        Loop
        End If
        FileName = FileName & "(" & I & ")"

CONTINUE1:

'名前のダブり確認*終了***************************************************

fnでファイル名を含むすべてのファイルを検索していますが、

        fn = "*" + FileName + ".Xls*"

とすると、エクセルのファイルだけを検出して避けることが可能です。

あとは、名前野田ぶりを無くしたので、ファイルを保存して終了です。
Worksheets.copy
の後に何もつけないと、新しいブックにコピーされますので、
SaveAsで保存して終了です。

FName = folderPath & "\" & FileName

'ファイルの保存***************************************************
    Worksheets.copy
    ActiveWorkbook.SaveAs _
    FileName:=FName, _
    FileFormat:=xlOpenXMLWorkbook
　'ファイルを閉じる
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

'ファイルの保存終了***************************************************

]]> https://nujonoa.com/create-and-save-serial-numbers/feed/ 0 【VBA】DBフォルダ内で名前が一致するファイルを立ち上げる方法 https://nujonoa.com/launch-the-files-in-the-db-folder/ https://nujonoa.com/launch-the-files-in-the-db-folder/#respond Thu, 28 Jan 2021 13:17:46 +0000 http://nujonoa.com/?p=8676 エクセルでデータベースを構築するには必須の、
データベースファルダからのファイルの取り出し方を紹介していこうと思います。

【VBA】DBフォルダ内で名前が一致するファイルを立ち上げる方法

エクセルでデータベースを構築しようと思うと、
データを格納してあるフォルダからファイルを取り出すことが第一ステップとなります。

そこで今回は、格納したデータの中から、
名前が一致したファイルを取り出す方法を紹介したいと思います。

ファイル立ち上げプログラム紹介

プラグラムは、下記のとおりです。
・イニシャルを変更してご使用ください。
※ダブルクリックするとコピーできます。

Sub VIEW_FILE()

  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With
  
    Dim fnd As String
    Dim fn As String

        fn =  "*" + ActiveCell + "*" 
        fnd = Dir(folderPath + "\" + fn, vbNormal)

        'ファイルがない場合
        If (fnd = "") Then
             MsgBox "見つかりません"
             Exit Sub
        End If
        '表示
        With CreateObject("Wscript.Shell")
        
        Do While fnd <> ""

            .Run """" & folderPath & "\" & fnd & """"　'ファイル表示
        
           fnd = Dir '次のファイル
        Loop
        
        End With

End Sub

プログラム説明

コードの肝は、2点で、
①DBフォルダを選択する

 With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With

②ファイルを立ち上げる

        With CreateObject("Wscript.Shell")
        
        Do While fnd <> ""

            .Run """" & folderPath & "\" & fnd & """"　'ファイル表示
        
           fnd = Dir '次のファイル
        Loop

になります。
DBのフォルダを指定してもいいのですが、
少しだけ柔軟性を持たせるために①を追加しています。

②で、名前が一致するファイルを一つずつ開いていきます。

]]> https://nujonoa.com/launch-the-files-in-the-db-folder/feed/ 0